Sub FilterAUFTRAGSNR__TEST()
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) & "*"
<span style="color:#e74c3c">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</span>
End If
End Sub
Anforderung:
in dem rot markierten Bereich fehlen die "*". Ähnlich wie bei "ElseIf UBound(arr) = 2 Then".
Bekomme die "*" aber nicht einfach so da rein...