如何移动由 VBA 宏过滤的数据范围？

Question

我目前正在使用此代码过滤列 A 中的范围（从单元格 1 开始，到单元格 600）。它只会留下以数字开头的值。

Sub WildAutofilter()
    Dim data As Range, c As Collection
    Dim v As String, i As Long, ary
    Set data = Range("A1:A23")
    Set c = New Collection

    On Error Resume Next
        For i = 2 To 600
            v = Cells(i, 1).Value
            If Left(v, 1) = "1" Or Left(v, 1) = "2" Or Left(v, 1) = "3" Or Left(v, 1) = "4" Or Left(v, 1) = "5" Or Left(v, 1) = "6" Or Left(v, 1) = "7" Or Left(v, 1) = "8" Or Left(v, 1) = "9" Then
                c.Add v, CStr(v)
            End If
        Next i
    On Error GoTo 0

    ReDim ary(3 To c.Count - 1)
    For i = 4 To c.Count
        ary(i - 1) = c.Item(i)
    Next i

    With ActiveSheet.Range("$A$1:$A$23")
        .AutoFilter Field:=1, Criteria1:=(ary), Operator:=xlFilterValues
    End With
End Sub

此代码适用于该位置，但我实际要过滤的数据位于 C 列，从单元格 3 开始。我已尝试将代码更改为以下内容：

Sub WildAutofilter()
    Dim data As Range, c As Collection
    Dim v As String, i As Long, ary
    Set data = Range("C3:C26")
    Set c = New Collection

    On Error Resume Next
        For i = 4 To 600
            v = Cells(i, 3).Value
            If Left(v, 3) = "1" Or Left(v, 3) = "2" Or Left(v, 3) = "3" Or Left(v, 3) = "4" Or Left(v, 3) = "5" Or Left(v, 3) = "6" Or Left(v, 3) = "7" Or Left(v, 3) = "8" Or Left(v, 3) = "9" Then
                c.Add v, CStr(v)
            End If
        Next i
    On Error GoTo 0

    ReDim ary(0 To c.Count - 1)
    For i = 1 To c.Count
        ary(i - 1) = c.Item(i)
    Next i

    With ActiveSheet.Range("$C$3:$C$26")
        .AutoFilter Field:=1, Criteria1:=(ary), Operator:=xlFilterValues
    End With
End Sub

这总是返回一个下标超出范围的错误并突出显示这一行“ReDim ary(0 To c.Count - 1)”。我在视觉基础方面不是很先进。我的大部分经验是在“Frankensteining”其他人的代码中让它做我想做的事，这正是我对这段代码所做的。我不确定我是否只是没有更改正确的参考，但如果有人可以帮助我解决这个问题，那将不胜感激。

Answer 1

您几乎完成了转换，但您所做的也是更改了 if 条件（我认为是错误的）。当您将所有 1's 更改为 3's 时，您还更改了字符串操作，因此您使用的是 if 1 = 1xx 而不是 if 1 = 1 then，因此它永远不会填充您的集合。

下面应该修复。您还应该进行一些错误处理，以防您的 if 条件在将来也因正当理由而失败

Sub WildAutofilter()
    Dim data As Range, c As Collection
    Dim v As String, i As Long, ary
    Set data = Range("C3:C26")
    Set c = New Collection

    On Error Resume Next
        For i = 4 To 600
            v = Cells(i, 3).Value
            If Left(v, 1) = "1" Or Left(v, 1) = "2" Or Left(v, 1) = "3" _
            Or Left(v, 1) = "4" Or Left(v, 1) = "5" Or Left(v, 1) = "6" _
            Or Left(v, 1) = "7" Or Left(v, 1) = "8" Or Left(v, 1) = "9" Then
                c.Add v, CStr(v)
            End If
        Next i
    On Error GoTo 0

    ReDim ary(0 To c.Count - 1)
    For i = 1 To c.Count
        ary(i - 1) = c.Item(i)
    Next i

    With ActiveSheet.Range("$C$3:$C$26")
        .AutoFilter Field:=1, Criteria1:=(ary), Operator:=xlFilterValues
    End With
End Sub

只是添加到这个Left 使用如下： Left('string to manipulate', how many characters to keep)

请查看下面的 cmets 以了解其他解决方案，以获得更易于管理的 if 声明

Answer 2

Range("$C$3:$C$26") 与“2 到 600 行之间”有何关联？我定义了一个动态范围，它将根据您的列表自行调整大小。

Sub WildAutofilter()
    Dim r As Range
    Dim FilterArray
    Dim x As Long

    Dim c As Collection
    Set c = New Collection

    With ActiveSheet
        With .Range("C3", .Range("C" & .Rows.Count).End(xlUp))
            ReDim FilterArray(.Cells.Count)
            For Each r In .Cells
                If r.Text Like "[1-9]*" Then
                    On Error Resume Next
                    c.Add vbNullString, r.Text
                    If Err = 0 Then
                        FilterArray(x) = r.Text
                        x = x + 1
                    End If
                    On Error GoTo 0
                End If
            Next
            ReDim Preserve FilterArray(x)
            .AutoFilter Field:=1, Criteria1:=FilterArray, Operator:=xlFilterValues
        End With
    End With
End Sub

Answer 3

首先，您应该接受@Tom 的回答，因为它是正确的。

我只是想分享一个更简洁、更简短的代码版本供您调整（以供将来使用）。

不要使用很长的 If 以及相同条件的 9 个可能值，而是使用 Select。

其次，不需要将值复制到集合中，然后有另一个For 循环将Collection 复制到数组中。您可以只使用带有后期绑定的ary，以后每次需要调整数组大小并添加另一个元素时只需使用Redim Preserve。

代码

（已编辑 - 感谢 Tom cmets）

Sub WildAutofilter()

Dim Data As Range
Dim v As String, i As Long
Dim ary()
Dim arycounter  As Long

Set Data = Range("C3:C26")
Set c = New Collection

' initialize the size of the array to maximum
ReDim ary(1 To 1000)
arycounter = 1

On Error Resume Next
For i = 4 To 600
    v = Cells(i, 3).Value

    Select Case Left(v, 1)
        Case "1", "2", "3", "4", "5", "6", "7", "8", "9"
            ary(arycounter) = CStr(v)
            arycounter = arycounter + 1

    End Select

Next i
On Error GoTo 0

' resize array to number of matches found in the loop
ReDim Preserve ary(1 To arycounter - 1)

With Data
    .AutoFilter Field:=1, Criteria1:=(ary), Operator:=xlFilterValues
End With

End Sub

Answer 4

不确定您的收藏中有什么，因此尚未对此进行测试。但是尝试反转循环，这样您就不必重新调整尺寸

Sub WildAutofilter()
Dim data As Range, c As Collection
Dim v As String, i As Long, ary
Set data = Range("C3:C26")
Set c = New Collection

On Error Resume Next
    For i = 600 To 4 Step -1
        v = Cells(i, 3).Value
        If Left(v, 3) = "1" Or Left(v, 3) = "2" Or Left(v, 3) = "3" Or Left(v, 3) = "4" Or Left(v, 3) = "5" Or Left(v, 3) = "6" Or Left(v, 3) = "7" Or Left(v, 3) = "8" Or Left(v, 3) = "9" Then
            c.Add v, CStr(v)
        End If
    Next i
On Error GoTo 0


For i = c.Count To 1
    ary(i) = c.Item(i-1)
Next i

With ActiveSheet.Range("$C$3:$C$26")
    .AutoFilter Field:=1, Criteria1:=(ary), Operator:=xlFilterValues
End With
End Sub