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）”这一行。我在visual basic方面不是很先进。我的大多数经验都是在'Frankensteining'其他人的代码中使它做我想做的事，这正是我对这段代码所做的。我不确定我是不是在改变正确的引用，但是如果有人可以帮我解决这个问题，我将不胜感激。

Answer 1

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

下面应该修复。你也应该进行一些错误处理，以防你的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)

请查看以下评论以及其他解决方案以获得更易于管理的if声明

Answer 2

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

我只想分享一个更清晰，更短的代码版本供您调整（适用于未来的情况）。

使用If，而不是将Select用于同一条件的9个可能值，而不是For。

其次，不需要将值复制到集合，然后使用另一个Collection循环将ary复制到数组。您可以使用Redim Preserve进行后期绑定，然后在每次需要调整数组大小并添加其他元素时使用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。

代码

（编辑 - 感谢汤姆评论）

{{1}}

Answer 3

Range("$C$3:$C$26")如何与＆＃34; 2到600行之间的关联＆＃34;？我定义了一个动态范围，它将自己调整到你的列表。

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 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

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

4 个答案:

代码