Question

我已经修改了我的Excel宏，它之前逐行进行，它现在可以批量过滤结果和副本。效率更高。

我现在遇到的问题是，自动过滤器会在工作表中添加数百万个空行，但我无法确定原因。

CountryCodes是一个包含过滤器值的字典。 Criteria正在寻找包含字典中条目的行。

这是代码：

    For Each vall In CountryCodes
    thisWB.Activate
    thisWB.Sheets("Overall Numbers").Activate

    lookfor = CountryCodes.Item(vall)
    rep = Replace(thisWBName, "EMEA", lookfor)

    Set rng = ActiveSheet.Range("A1:Z1")

    FilterField = WorksheetFunction.Match("Host", rng.Rows(1), 0)

    If ActiveSheet.AutoFilterMode = False Then rng.AutoFilter

    rng.AutoFilter Field:=FilterField, Criteria1:="=*" & lookfor & "*", Operator:=xlFilterValues

    Set rng2 = ThisWorkbook.Worksheets("Overall Numbers").Cells.SpecialCells(xlCellTypeVisible)

    rng2.Copy Workbooks(rep).Worksheets("Overall Numbers").Range("A1")

    Workbooks(rep).Save

    thisWB.Activate
    thisWB.Sheets("Overall Numbers").Activate

    Cells.AutoFilter
Next

Answer 1

测试：

Dim ur As Range
Set ur = ThisWorkbook.Sheets("Overall Numbers").UsedRange

Application.ScreenUpdating = False
filterField = Application.Match("Host", ur.Rows(1), 0)
If Not IsError(filterField) Then

    For Each vall In countryCodes
       rep = Replace(thisWBName, "EMEA", vall)

       ur.AutoFilter Field:=filterField, Criteria1:="=*" & vall & "*"

       'copy visible rows with data only
       ur.SpecialCells(xlCellTypeVisible).Copy

       'paste visible rows with data only
       Workbooks(rep).Worksheets("Overall Numbers").Range("A1").PasteSpecial xlPasteAll
       Workbooks(rep).Save

       ur.AutoFilter
    Next
End If
Application.ScreenUpdating = True

Answer 2

我重新组织了您的代码并删除了.Activate依赖，并使用Range.CurrentRegion property隔离了过滤后的数据。

With thisWB
    With .Worksheets("Overall Numbers")
        If .AutoFilterMode Then .AutoFilterMode = False

        lookfor = CountryCodes.Item(vall)
        rep = Replace(thisWBName, "EMEA", lookfor)

        With .Cells(1, 1).CurrentRegion
            FilterField = WorksheetFunction.Match("Host", .Rows(1), 0)
            For Each vall In CountryCodes
                .AutoFilter Field:=FilterField, Criteria1:="=*" & lookfor & "*", Operator:=xlFilterValues
                If CBool(Application.Subtotal(103, .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0))) Then
                    .Copy Workbooks(rep).Worksheets("Overall Numbers").Range("A1")
                    Workbooks(rep).Save
                End If
                .AutoFilter Field:=FilterField
            Next vall
        End With
    End With
    .AutoFilter
End With

除非rep以某种方式递增，否则每次迭代都会粘贴到相同的工作簿/工作表/范围。

Excel VBA AutoFilter添加空行

2 个答案: