Question

我想要一个宏，该宏可以复制几个选项卡中的所有数据，这些选项卡与“摘要（已过滤）”选项卡中定义的过滤器行一致。详细信息如下：

所有选项卡具有相同的标题。
过滤行是“摘要（已过滤）”标签中的第7行。
我要遍历除以下列出的选项卡之外的所有选项卡，检查每一行并将其满足过滤条件（如果过滤器行中的给定单元格为空，则允许所有值，否则必须匹配）将其复制到“摘要”选项卡。
我希望复制从“摘要”选项卡的第9行开始。

我试图通过循环函数解决它，但是出现应用程序或对象定义的错误。另外，我认为双循环的有效性非常差。

Sub CopyDataFiltered()
    Dim sh          As Worksheet
    Dim SourceSh    As Worksheet
    Dim Last        As Long
    Dim shLast      As Long
    Dim CopyRng     As Range
    Dim StartRow    As Long
    Dim lrow        As Long
    Dim r           As Long
    Dim col         As Long

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set SourceSh = ActiveWorkbook.Worksheets("Summary (Filtered)")
    Application.DisplayAlerts = False
    On Error Resume Next
    On Error GoTo 0

    For Each sh In ActiveWorkbook.Worksheets
        If IsError(Application.Match(sh.Name, Array(SourceSh.Name, "List Data", "Summary (All)", "Lists"), 0)) Then

            lrow = LastRow(sh)

            If lrow < 7 Then
                'MsgBox ("Nothing to move")
                GoTo NextTab
            End If

            For r = LastRow(sh) To 7 Step -1
                For col = 1 To 16

                    If SourceSh.Range(7, col).Value <> "" And SourceSh.Range(7, col).Value <> sh.Range(r, col).Value Then
                        GoTo End1
                    End If

                Next col
                sh.Rows(r).Copy Destination:=SourceSh.Range("A" & LastRow(SourceSh) + 1)

End1:
            Next r
        End If
NextTab:
    Next

ExitTheSub:
    Application.Goto SourceSh.Cells(1)
    Application.DisplayAlerts = True
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

请您看看，让我知道您认为最好的吗？

Answer 1

因此，这几乎是您相同的方法，只是将其重新整理为一种表格，该表格将流程的每个步骤隔离开来，以阐明您要完成的工作。只要您跟踪要执行的操作，嵌套循环就不成问题。我想让您远离的是使用[ { "name": "john", "age": 20, "gender": "male" } ,{ "name": "jane", "age": 30, "gender": "female" } ,{ "name": "bob", "age": 25, "gender": "male" } ]语句。他们几乎从来没有必要。

所以首先要做的事情...

始终使用GoTo并在尽可能靠近要使用它们的位置声明变量。这种习惯使您更容易理解每个变量的含义以及其用途。如果在顶部都声明了它们，则总是会来回弹出来找到它们。

Option Explicit

由于您将始终在同一位置引用过滤器，因此只需定义一个专门与过滤器匹配的变量即可。这里的好处是，如果您的过滤器从第7行更改为第8行，例如，您只需要在一个位置上进行更改即可。

Option Explicit

Sub CopyFilteredData()
    Dim srcWB As Workbook
    Dim srcWS As Worksheet
    Set srcWB = ActiveWorkbook
    Set srcWS = srcWB.Sheets("Summary (Filtered)")

使用相同的想法，设置一个变量，以明确定义要跳过的工作表：

    Dim srcFilter As Range
    Set srcFilter = srcWS.Range("A7").Resize(1, 16)

This answer提供了出色的功能，可以检查您的工作表名称是否在该数组中。

您未包含Dim skipTheseSheets As Variant skipTheseSheets = Array(srcWS.Name, "List Data", "Summary (All)", "Lists") Dim sh As Worksheet For Each sh In srcWB.Sheets If Not IsInArray(sh.Name, skipTheseSheets) Then的函数，因此我将其包含在答案中。但是，养成使用描述函数功能的动词来命名函数的习惯。在这种情况下，LastRow。

为了停止使用FindLastRow语句，只需反转GoTo语句，如果通过则继续：

If

我创建了一个单独的函数，将给定的行与您的过滤器进行比较。它基本上使用相同的逻辑，但是通过将其隔离为一个函数，可以使您的主逻辑更简单地读取。另外，请注意，您可以退出Dim lastRow As Long lastRow = FindLastRow(sh) If lastRow > 7 Then循环并避免可怕的For：

GoTo

所以您的复制循环最终看起来像这样：

Private Function RowMatchesFilter(ByRef thisRow As Range, _
                                  ByRef thisFilter As Range) As Boolean
    '--- the row matches only if the value in thisRow equals the value
    '    in the filter
    RowMatchesFilter = True
    Dim i As Long
    For i = 1 To 16
        If Not IsEmpty(thisFilter.Cells(1, i).Value) Then
            If thisRow.Cells(1, i).Value <> thisFilter.Cells(1, i).Value Then
                '--- the first cell that doesn't match invalidates the
                '    entire row
                RowMatchesFilter = False
                Exit For
            End If
        End If
    Next i
End Function

这是整个模块：

Dim r As Long
For r = lastRow To 7 Step -1
    If RowMatchesFilter(sh.Rows(r), srcFilter) Then
        sh.Rows(r).Copy
        srcWS.Range("A" & FindLastRow(srcWS) + 1).PasteSpecial xlPasteAll
    End If
Next r

用于根据过滤后的行从选项卡复制数据的宏

1 个答案: