Question

我有一个电子表格，其中包含一个与食品成分有关的大量原始数据表。然后必须对新数据进行分类，清除旧数据，填充新数据。

最初设置了电子表格，以便用户必须手动点击“清除数据”按钮，然后点击每个标签上的“拉新数据”按钮。这本工作簿有很多标签，并且随着新成分的添加而不断增长。

我已经设置了一个宏，它可以通过一次运行完成并清除所有数据，但是我无法让工作表动态排序并将数据提取到每个单独的工作表。我可以通过对每个单独选项卡的名称进行硬编码来强制执行它，但是每次必须添加新成分时都需要更新宏。我希望尽可能让它变得充满活力，并感觉我很亲近。

每个成分表在“A1”中都有成分的相应材料编号，用作搜索中的标识符。

我需要从电子表格中获得的整体行为是这样的： 1.）将活动工作表A1范围内的材料编号与“原始数据”工作表上的第一个材料编号进行比较。

2.）如果活动工作表的材料编号与当前行中的材料编号匹配，则将原始数据工作表上的整行复制到活动工作表。

3.）如果这些单元格不匹配，则移动到列中的下一行并重复直到列的末尾。

4.。）激活工作簿中的下一个工作表并重复该过程，直到所有工作表都循环完毕。

以下是我目前的代码：

Sub PullNewData()

Dim wks As Worksheet
Set i = Sheets("Raw Data")
Set e = ActiveSheet
Dim d
Dim j
d = 20
j = 2

For Each wks In ActiveWorkbook.Worksheets

If wks.Name <> "Ingredient List" Then

    If wks.Name <> "Raw Data" Then

        If wks.Name <> "Instructions" Then

            wks.Activate

            For Each Cell In i.Range("B2:B10000")

            If i.Range("B" & j) = e.Range("A1") Then
            d = d + 1
            e.Rows(d).Value = i.Rows(j).Value

            End If
            j = j + 1
            Next Cell

        d = 20
        j = 2

        End If

    End If

End If

Next wks


End Sub

此代码适用于激活的任何工作表（提取正确的数据），然后循环其余工作表而不复制任何工作表的数据。任何人都可以告诉我为什么这段代码没有复制到最初未激活的工作表？

PS开头附近的三重IF语句是排除三张数据的排序。

Answer 1

这不依赖于ActiveSheet

Option Explicit

Public Sub PullNewData2()

    Const RAW_COL = 2           'B column in "Raw Data" ws
    Const THIS_LAST_ROW = 20    'last used row on current ws

    Dim ws As Worksheet, wsRaw As Worksheet, urRaw As Variant, r As Long

    Set wsRaw = ThisWorkbook.Worksheets("Raw Data")
    urRaw = wsRaw.UsedRange

    Dim xclude As Variant, cellA1 As String, lr As Long, foundRow As Long
    xclude = Array("Ingredient List", "Raw Data", "Instructions")

    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> xclude(0) And ws.Name <> xclude(1) And ws.Name <> xclude(2) Then
            foundRow = THIS_LAST_ROW
            cellA1 = Trim$(ws.Range("A1").Value2)
            For r = 2 To UBound(urRaw)
                If urRaw(r, RAW_COL) = cellA1 Then
                    foundRow = foundRow + 1
                    ws.Rows(foundRow).Value = wsRaw.Rows(r).Value
                End If
            Next r
        End If
    Next ws
End Sub

更快的方法是使用AutoFilter

Option Explicit

Sub PullNewData3()
    Const RAW_COL = 2       'B column in "Raw Data" ws
    Const FIRST_ROW = 21

    Dim ws As Worksheet, wsRaw As Worksheet, xclude As Variant, cellA1 As String

    Set wsRaw = ThisWorkbook.Worksheets("Raw Data")
    xclude = Array("Ingredient List", "Raw Data", "Instructions")
    optimizeXL True
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> xclude(0) And ws.Name <> xclude(1) And ws.Name <> xclude(2) Then
            cellA1 = Trim$(ws.Range("A1").Value2)

            With wsRaw.UsedRange
                If wsRaw.AutoFilterMode Then .AutoFilter    'clear filters
                .AutoFilter Field:=RAW_COL, Criteria1:=cellA1
                .Copy ws.Cells(FIRST_ROW, 1)
                ws.Cells(FIRST_ROW, 1).EntireRow.Delete     'if 1st row contains Headers
                .AutoFilter  'clear filter
            End With

        End If
    Next ws
    optimizeXL False
End Sub

Public Sub optimizeXL(Optional ByVal settingsOff As Boolean = True)
    With Application
        .ScreenUpdating = Not settingsOff
        .Calculation = IIf(settingsOff, xlCalculationManual, xlCalculationAutomatic)
        .EnableEvents = Not settingsOff
    End With
End Sub

从动态范围动态拉出数据行

1 个答案: