Hallo zusammen,
ich bitte um Hilfe: VBA Excel 2019
Das Filterkriterium sollte bei Auswahl >2 genauso greifen wie bei Auswahl = 2, also mit jeweils "*" vor und "*" nach der entsprechenden Auswahl.
Danke dir/euch...
Sub FilterAUFTRAGSNR()
Dim ARR As Variant
Dim rng As Range, va As Variant
Dim i As Long, j As Long, k As Long
Set rng = Selection.SpecialCells(xlCellTypeConstants)
ReDim ARR(1 To rng.Count)
k = 1
For i = 1 To rng.Areas.Count
For j = 1 To rng.Areas(i).Cells.Count
If rng.Areas(i).Cells(j).Value <> "" Then
ARR(k) = rng.Areas(i).Cells(j).Text
k = k + 1
End If
Next j
Next i
If UBound(ARR) = 1 Then
Dim s As String
va = xlAnd: s = ARR(1)
Workbooks("Laufende Aufträge.xlsm").Worksheets("Laufende Aufträge").Range("A1:Q1").AutoFilter _
Field:=5, Criteria1:="*" & s & "*", Operator:=va
ElseIf UBound(ARR) = 2 Then
va = xlOr
Workbooks("Laufende Aufträge.xlsm").Worksheets("Laufende Aufträge").Range("A1:Q1").AutoFilter _
Field:=5, Criteria1:="*" & ARR(1) & "*", Operator:=va, Criteria2:="*" & ARR(2) & "*"
ElseIf UBound(ARR) > 2 Then
va = xlFilterValues
Workbooks("Laufende Aufträge.xlsm").Worksheets("Laufende Aufträge").Range("A1:Q1").AutoFilter _
Field:=5, Criteria1:=ARR, Operator:=va
End If
End Sub
|