Автофильтр Excel VBA для нескольких подстановочных знаков, затем изменить значение поля и заполнить - PullRequest
Новая
       16

Автофильтр Excel VBA для нескольких подстановочных знаков, затем изменить значение поля и заполнить

0 голосов
/ 15 ноября 2018

У меня есть поиск, пока я не могу найти, как это сделать, и он работает правильно. То, что я пытаюсь сделать, это найти значение подстановочного знака, которое больше, чем один. Я также хотел бы заполнить колонку Z.

Что происходит, если я ввожу более 1 символа подстановки, он находит только один из них, хотя в столбце их много. Если возвращается только 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

Это изображение результата отфильтрованного списка, если я вручную введу "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
...