Option
Explicit
Sub
TestIt()
Dim
oList
As
Object
Dim
c
As
Range
Dim
x
As
Long
Dim
az, aIni, zs
Set
c = Selection
If
Len(c.Text) = 0
Or
c.EntireColumn.Cells(1).Value <>
"Kunde"
Then
Exit
Sub
az = arrZustand()
aIni = IniFilterArray(c.Value)
Set
oList = CreateObject(
"System.Collections.ArrayList"
)
For
x = LBound(aIni)
To
UBound(aIni)
If
Not
IsEmpty(aIni(x, 1))
Then
oList.Add az(x, 1)
Next
x
ActiveSheet.UsedRange.AutoFilter
ActiveSheet.UsedRange.AutoFilter Field:=3, Criteria1:=c.Text
If
oList.Count > 0
Then
zs = oList.toarray
ActiveSheet.UsedRange.AutoFilter Field:=5, Criteria1:=zs, Operator:=xlFilterValues
End
If
End
Sub
Private
Function
arrZustand()
As
Variant
Dim
rz
As
Range
With
Sheets(
"Einstellungen"
)
Set
rz = .Cells.Find(
"Zustand"
)
If
Not
rz
Is
Nothing
Then
Set
rz = Range(rz.Offset(2), .Cells(.Rows.Count, rz.Column).
End
(xlUp))
arrZustand = rz
Else
Call
MsgBox(
"Spalte Zustand nicht gefunden!"
, vbCritical,
"Prozedurabbruch"
)
End
End
If
End
With
End
Function
Private
Function
IniFilterArray(
ByVal
sKunde
As
String
)
As
Variant
Dim
rz
As
Range, rk
As
Range
With
Sheets(
"Einstellungen"
)
Set
rz = .Cells.Find(
"Zustand"
)
Set
rz = Range(rz.Offset(2), .Cells(.Rows.Count, rz.Column).
End
(xlUp))
Set
rk = .Cells.Find(sKunde)
If
Not
rk
Is
Nothing
Then
Set
rk = rk.Offset(3)
Set
rk = rk.Resize(rz.Cells.Count)
IniFilterArray = rk
Else
Call
MsgBox(
"Wert nicht gefunden!"
, vbCritical,
"Prozedurabbruch"
)
End
End
If
End
With
End
Function