简体   繁体   中英

Excel VBA Autofilter using array - multiple values in same column

I feel like the answer is out there, but after lots of searching and experimenting, I am still coming up short.

So can see in the first image that column O had a comma separated list of values. I would like my routine to filter the data on column A using the entire list when the user double click on the cell containing the list.

在执行例行程序之前

My code reads:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Not Intersect(Target, Range("O:O")) Is Nothing Then
    Sheet1.Cells.AutoFilter 'clear existing filters
    Dim idArray() As String
    idArray = Split(Target.Value, ",") 'store cell contents in array
    Dim newIDArray(0 To 100) As String
    Dim i As Long
    For i = 0 To UBound(idArray)
     newIDArray(i) = """" & CStr(idArray(i)) & """"   'wrap elements with quotes ... not sure if needed
    Next
    Sheet1.Range("$A$8").AutoFilter Field:=1, Criteria1:=newIDArray
End If

Cancel = False
End Sub

However the result is the following image. I looks like it is taking the filter in column A, deselecting All and showing results .... it is not using the values from the comma delimited list at all.

Any thoughts on what is happening? Thanks for reading.

运行双击单元格后

On my setup:

  • The comma separated values correspond to Range("J1:J3")
  • The range to filter correspond to Range("A1:A18")

Please see correct way to appropriately size ( ReDim ) an array and how to add values to it below


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim Arr          'Array to SPLIT string
Dim i As Long    'Index to loop through Arr
Dim Filt         'Array to filter range

If Not Intersect(Target, Range("J1:J3")) Is Nothing Then
    Arr = Split(Target, ",")
    ReDim Filt(LBound(Arr) To UBound(Arr))
        For i = LBound(Arr) To UBound(Arr)
            Filt(i) = CStr(Arr(i))
        Next i
    Range("A1:A18").AutoFilter 1, Filt, xlFilterValues
End If

End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM