自动筛选器执行阶段错误'91'VBA

Question

我需要你的帮助。

我想使用以下值自动过滤表的列：以AF开头。 然后将某些列复制并粘贴到另一张纸上。

我已经编写了代码，但是当代码到达以下行时，我总是收到错误消息：

.AutoFilter字段：= rng0.Column，条件1：= SearchFor

错误是：未设置对象变量或with块。

我不知道代码有什么问题。 请帮我。

Sub AF_update()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

SearchCol0 = "Prefix+short name"
SearchCol1 = "Site type"
SearchCol2 = "SLA Target"
SearchCol3 = "Mean Rtt (ms)"
SearchCol4 = "Max Rtt (ms)"
SearchCol5 = "Threshold 95%"
SearchCol6 = "Threshold 99%"
SearchFor = "=AF*"

Dim rng0, rng1, rng2, rng3, rng4, rng5, rng6 As Range
Dim lastrow As Long

Set rng0 = ActiveSheet.UsedRange.Find(SearchCol0, , xlValues, xlWhole)
Set rng1 = ActiveSheet.UsedRange.Find(SearchCol1, , xlValues, xlWhole)
Set rng2 = ActiveSheet.UsedRange.Find(SearchCol2, , xlValues, xlWhole)
Set rng3 = ActiveSheet.UsedRange.Find(SearchCol3, , xlValues, xlWhole)
Set rng4 = ActiveSheet.UsedRange.Find(SearchCol4, , xlValues, xlWhole)
Set rng5 = ActiveSheet.UsedRange.Find(SearchCol5, , xlValues, xlWhole)
Set rng6 = ActiveSheet.UsedRange.Find(SearchCol6, , xlValues, xlWhole)



Set Target = ThisWorkbook.Worksheets("AF")
Set Source = ThisWorkbook.Worksheets("RAW DATA")

Target.Select

Range("A2").Select
Range(ActiveCell, Cells(ActiveCell.End(xlDown).Row, ActiveCell.End(xlToRight).Column)).Select
Selection.ClearContents

    Source.Select

    If ActiveSheet.AutoFilterMode = True Then
        Range("a1").AutoFilter
    End If

    Range("A1").Select
    With Selection
    .AutoFilter Field:=rng0.Column, Criteria1:=SearchFor
    End With


    rng0.Offset(1, 0).Select
    Range(Selection, Selection.End(xlDown)).Copy
    Target.Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Source.Select
    rng1.Offset(1, 0).Select
    Range(Selection, Selection.End(xlDown)).Copy
    Target.Select
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Source.Select
    rng2.Offset(1, 0).Select
    Range(Selection, Selection.End(xlDown)).Copy
    Target.Select
    Range("C2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Source.Select
    rng3.Offset(1, 0).Select
    Range(Selection, Selection.End(xlDown)).Copy
    Target.Select
    Range("D2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Source.Select
    rng4.Offset(1, 0).Select
    Range(Selection, Selection.End(xlDown)).Copy
    Target.Select
    Range("E2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Source.Select
    rng5.Offset(1, 0).Select
    Range(Selection, Selection.End(xlDown)).Copy
    Target.Select
    Range("F2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Source.Select
    rng6.Offset(1, 0).Select
    Range(Selection, Selection.End(xlDown)).Copy
    Target.Select
    Range("G2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False



    lastrow = Cells(Rows.Count, 5).End(xlUp).Row
    Range("A2:G" & lastrow).Sort key1:=Range("E2:E" & lastrow), order1:=xlDescending, Header:=xlNo

Source.Select
ActiveSheet.AutoFilterMode = False

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True

MsgBox "Operation Completed!"
End Sub

Answer 1

我已经清理了您的代码； 主要是消除对.Select和.Activate的依赖，但也要获取变量组并为每个组创建数组。 这允许循环，从而大大缩短了代码，同时允许完整的功能。

Sub AF_update()
    Dim v As Long, vSearchCols As Variant, vCols As Variant, FilterFor As String
    Dim Source As Worksheet, Target As Worksheet

    'Application.ScreenUpdating = False
    'Application.DisplayAlerts = False
    'Application.EnableEvents = False

    FilterFor = "AF*"

    Set Source = ThisWorkbook.Worksheets("RAW DATA")
    With Source
        'array of 'SearchCol' values on a zero-based index
        vSearchCols = Array("Prefix+short name", "Site type", "SLA Target", "Mean Rtt (ms)", _
                           "Max Rtt (ms)", "Threshold 95%", "Threshold 99%")
        ReDim vCols(0 To UBound(vSearchCols))  'make them the same size
        For v = LBound(vSearchCols) To UBound(vSearchCols)
            vCols(v) = .Rows(1).Cells.Find(What:=vSearchCols(v), LookIn:=xlFormulas, LookAt:=xlWhole).Column
        Next v
    End With

    Set Target = Worksheets("AF")
    With Target
        If .AutoFilterMode Then .AutoFilterMode = False
        With .Cells(1, 1).CurrentRegion
            Debug.Print .Cells(.Rows.Count - 1, .Columns.Count).Address(0, 0, external:=True)
            .Cells.Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0).ClearContents
        End With
    End With

    With Source
        If .AutoFilterMode Then .AutoFilterMode = False
        With .Cells(1, 1).CurrentRegion
            .AutoFilter Field:=vCols(0), Criteria1:=FilterFor

            'check to see if there is anything to copy across
            With .Cells.Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0)
                If CBool(Application.Subtotal(103, .Cells)) Then
                    'there is something to transfer; loop through the ranges
                    For v = LBound(vCols) To UBound(vCols)
                        .Columns(vCols(v)).Copy
                        Target.Cells(2, v + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                                                            SkipBlanks:=False, Transpose:=False
                    Next v
                End If
            End With
        End With
    End With

    With Target
        With .Cells(1, 1).CurrentRegion
            With .Resize(.Rows.Count, 7)
                .Cells.Sort Key1:=.Columns(5), Order1:=xlDescending, _
                            Orientation:=xlTopToBottom, Header:=xlYes
            End With
        End With
    End With

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True

    MsgBox "Operation Completed!"
End Sub

您可能希望反复按F8来逐步浏览代码。 我暂时评论了您的应用程序环境更改。

当处理源自A1的数据块或“孤岛”时， Range.CurrentRegion属性是一种快速有效的隔离数据的方法，当使用With ... End With语句进行引用时。

我不得不猜测宏代码从哪个工作表开始。 我选择了RAW DATA工作表。

---

¹ _{有关如何摆脱依赖选择和激活来实现目标的更多方法，请参见如何避免在Excel VBA宏中使用“选择” 。}