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

我宁愿尝试循环而不是autofilter，如果有人有任何想法......

Answer 1

您的问题和代码不明确：

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

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

Bellow是2个版本 - 首先使用AutoFilter，第二个使用循环

两者都复制符合“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

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

示例：

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

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

1 个答案: