循环通过列搜索，并复制每个单元格的行，只要它符合某些条件

Question

我决定尝试对不符合我的条件的任何内容进行自动调整，然后选择剩余的行作为范围。但是，这段代码有问题，给我带来了麻烦。我试图循环的列是列“A”，然后我复制整个范围，并粘贴到名为 Payroll Journal 的工作簿中特定范围内的另一张表中（“B9：E28”）我的完整代码用于此的是：

---

Sub Filter_by_Tax()

    'Filter_by_Tax Macro
    Cells.Select

    Selection.AutoFilter
    ActiveWorkbook.Sheets("dat.").Range("A1:D100").AutoFilter Field:="1", _
            Criteria1:=">199999", Operator:=xlAnd, Criteria2:="<200240"
End Sub

Sub Copy_and_Paste_Tax()
    'Copy  Tax into the Payroll Journal
    Dim rngT1 As Range

    'Set the worksheet name and range appropriately
    Set rngT1 = Range(ActiveSheet.Range("A2"), ActiveSheet.Range("D2").End(xlDown))

    rngT1.Copy

    'Paste Tax in payroll Journal
    ActiveWorkbook.Sheets("Payroll Journal").Range("B9:E28").PasteSpecial xlPasteValues
    Rows("1:1").Select

    'Turn off Filter
    Selection.AutoFilter
End Sub

---

如果有人有任何想法，我宁愿尝试循环而不是自动过滤器...

Answer 1

你的问题和代码不清楚：

...复制整个范围，然后粘贴到工作簿的另一张工作表中 在特定范围内命名工资单（“B9：E28”）...

• 复制整个范围您可能指的是整行
  • 但如果该行是“A2:F2”，它将不适合“B9:E9”行的另一张纸
• ...名为 Payroll Journal 的工作簿 - 您的代码引用同一文件中的 工作表 Payroll Journal
• 为什么您更喜欢在自动过滤器上循环 - 循环要慢得多

---

下面是 2 个版本 - 第一个使用自动过滤器，第二个使用循环

• 两者都从“dat”复制符合条件的整行。从 B9 开始到“工资日记帐”

---

Option Explicit

Public Sub FilterByTaxAutoFilter()
    Dim wsSrc As Worksheet, wsDst As Worksheet

    Set wsSrc = ThisWorkbook.Worksheets("dat.")
    Set wsDst = ThisWorkbook.Worksheets("Payroll Journal")

    Application.ScreenUpdating = False
    With wsSrc.UsedRange
        If wsSrc.AutoFilterMode Then .AutoFilter
        .AutoFilter Field:="1", Criteria1:=">199999", Operator:=xlAnd, Criteria2:="<200240"
        If .Cells(1).Value2 > 199999 And .Cells(1).Value2 < 200240 Then
            .Copy wsDst.Range("B9")
        Else
            .Offset(1).Resize(.Rows.Count - 1, .Columns.Count).Copy wsDst.Range("B9")
        End If
        .AutoFilter
    End With
    Application.ScreenUpdating = True
End Sub

---

Public Sub FilterByTaxLoop()
    Dim wsSrc As Worksheet, wsDst As Worksheet, cel As Range, wsDstRow As Long

    Set wsSrc = ThisWorkbook.Worksheets("dat.")
    Set wsDst = ThisWorkbook.Worksheets("Payroll Journal")

    Application.ScreenUpdating = False
    wsDstRow = 9
    With wsSrc.UsedRange
        For Each cel In .Columns(1).Cells
            If cel.Value2 > 199999 And cel.Value2 < 200240 Then
                .Rows(cel.Row).Copy wsDst.Range("B" & wsDstRow)
                wsDstRow = wsDstRow + 1
            End If
        Next
    End With
    Application.ScreenUpdating = True
End Sub

---

循环版本只是为了演示如何在 A 列中使用数据 (UsedRange) 遍历所有单元格，但这会导致与 Range 对象的大量交互 - 读取和复制每个单元格和行，一个位于时间，比在一个操作中复制和粘贴所有行要慢得多，例如使用自动过滤器

如果您没有 AutoFilter 选项，循环数据的更好/更快的方法是将整个范围复制到数组中，再次在一次操作中。二维数组（在内存中）在概念上类似于工作表上的数据 - 维度 1 是行，维度 2 - 列

例子：

• 声明一个数组：Dim arr As Variant
• 复制以下范围内的所有数据：arr = ThisWorkbook.Worksheets("dat.").UsedRange
• 更新范围内的单元格 A2：Cells(2, 1) = "Test Range"
• 更新数组中的单元格A2：arr(2, 1) = "Test Array"
• 将数组中的数据复制回范围：ThisWorkbook.Worksheets("dat.").UsedRange = arr