Excel VBA自动筛选多个通配符，然后更改字段值和填充

Question

我一直进行搜索，直到找不到如何执行此操作为止。我想做的是找到一个不止一个的通配符值。我也想填写Z列。

正在发生的事情是，如果我输入多个通配符，即使该列包含多个通配符，它​​也只会找到其中一个。如果仅返回1，则输入第1层，然后在填充时默认返回第2层。

提前感谢您的帮助！

ActiveSheet.Range("$A$1:$AB$" & Rows.Count).End(xlUp).AutoFilter Field:=13, Criteria1:=Array( _
    "*9365*", "*9575*", "*9375*"), _
Operator:=xlOr
With Worksheets("Raw Data").AutoFilter.Range
   Range("Z" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row).Select
End With
ActiveCell.FormulaR1C1 = "Tier 1"
With ActiveSheet.UsedRange
.Resize(.Rows.Count - 1).Offset(1).Columns("Z"). _
   SpecialCells(xlCellTypeVisible).FillDown
End With

我已尝试按@dwirony进行修复，但我的值未返回任何数据。

Sub AutoFilterWorkaround()

Dim sht As Worksheet
Dim filterarr As Variant, tofindarr As Variant
Dim lastrow As Long, i As Long, j As Long, k As Long

Set sht = ThisWorkbook.Worksheets("Raw Data")
lastrow = sht.Cells(sht.Rows.Count, "Z").End(xlUp).Row

'List the parts of the words you need to find here
 tofindarr = Array("9365", "9375")

ReDim filterarr(0 To 0)
j = 0

For k = 0 To UBound(tofindarr)

For i = 2 To lastrow
    If InStr(sht.Cells(i, 1).Value, tofindarr(k)) > 0 Then
        filterarr(j) = sht.Cells(i, 1).Value
        j = j + 1
        ReDim Preserve filterarr(0 To j)
    End If
Next i

Next k

'Filter on array
sht.Range("$A$1:$AB$" & lastrow).AutoFilter Field:=13, 
Criteria1:=Array(filterarr), Operator:=xlFilterValues

End Sub

This is a picture of the result of the filtered list if I manually enter "95" 这段代码成功了！

Sub AutoFilterWorkaround()

Dim sht As Worksheet
Dim filterarr As Variant, tofindarr As Variant
Dim lastrow As Long, i As Long, j As Long, k As Long

Set sht = ThisWorkbook.Worksheets("Raw Data")
lastrow = sht.Cells(sht.Rows.Count, "M").End(xlUp).Row

'List the parts of the words you need to find here
tofindarr = Array("9365", "9375")

ReDim filterarr(0 To 0)
j = 0

For k = 0 To UBound(tofindarr)

For i = 2 To lastrow
    If InStr(sht.Cells(i, 13).Value, tofindarr(k)) > 0 Then
        filterarr(j) = sht.Cells(i, 13).Value
        j = j + 1
        ReDim Preserve filterarr(0 To j)
    End If
Next i

Next k

'Filter on array
sht.Range("$M$1:$M$" & lastrow).AutoFilter Field:=13, 
Criteria1:=Array(filterarr), Operator:=xlFilterValues

End Sub