'In das Klassenmodul "DieseArbeitsmappe":Option Explicit
Private Sub Workbook_Open()
Set Ws = Worksheets(1)
Rows.Hidden = False
If Ws.Cells(65536, 3).End(xlUp).Row + 13 > Ws.Cells(65536, 8).End(xlUp).Row + 13 _
Then letzte = Ws.Cells(65536, 3).End(xlUp).Row + 13 Else letzte = Ws.Cells(65536, 8).End(xlUp).Row + 13
LListe1 = Ws.Range("C14:C" & CStr(letzte))
LListe2 = Ws.Range("H14:H" & CStr(letzte))
Filterstart
Worksheets(1).ComboBox1.Value = "alle"
Worksheets(1).ComboBox2.Value = "alle"
Worksheets(1).ComboBox1.BackColor = RGB(255, 255, 255)
Worksheets(1).ComboBox2.BackColor = RGB(255, 255, 255)
End Sub
'In das Klassenmodul von Tabelle1:
Option Explicit
Private Sub ComboBox1_Change()
Dim Zeile As Long
Application.ScreenUpdating = False
If ComboBox1.Value = "alle" Then
ComboBox1.BackColor = RGB(255, 255, 255)
If ComboBox2.Value = "alle" Then
Rows.Hidden = False
Else
For Zeile = letzte - 13 To 1 Step -1
If ComboBox2.Value = CStr(LListe2(Zeile, 1)) Then Rows(Zeile + 13).Hidden = False
Next
End If
Else
ComboBox1.BackColor = RGB(204, 255, 255)
If ComboBox2.Value = "alle" Then
For Zeile = letzte - 13 To 1 Step -1
If ComboBox1.Value <> CStr(LListe1(Zeile, 1)) Then Rows(Zeile + 13).Hidden = True Else Rows(Zeile + 13).Hidden = False
Next
Else
For Zeile = letzte - 13 To 1 Step -1
If ComboBox1.Value <> CStr(LListe1(Zeile, 1)) And ComboBox2.Value = CStr(LListe2(Zeile, 1)) Then Rows(Zeile + 13).Hidden = True
Next
End If
End If
Application.ScreenUpdating = True
Filterstart
End Sub
Private Sub ComboBox2_Change()
Dim Zeile As Long
Application.ScreenUpdating = False
If ComboBox2.Value = "alle" Then
ComboBox2.BackColor = RGB(255, 255, 255)
If ComboBox1.Value = "alle" Then
Rows.Hidden = False
Else
For Zeile = letzte - 13 To 1 Step -1
If ComboBox1.Value = CStr(LListe1(Zeile, 1)) Then Rows(Zeile + 13).Hidden = False
Next
End If
Else
ComboBox2.BackColor = RGB(204, 255, 255)
If ComboBox1.Value = "alle" Then
For Zeile = letzte - 13 To 1 Step -1
If ComboBox2.Value <> CStr(LListe2(Zeile, 1)) Then Rows(Zeile + 13).Hidden = True Else Rows(Zeile + 13).Hidden = False
Next
Else
For Zeile = letzte - 13 To 1 Step -1
If ComboBox2.Value <> CStr(LListe2(Zeile, 1)) And ComboBox1.Value = CStr(LListe1(Zeile, 1)) Then Rows(Zeile + 13).Hidden = True
Next
End If
End If
Application.ScreenUpdating = True
Filterstart
End Sub
'In ein "normales" Modul:
Option Explicit
Option Private Module
Option Base 1
Public feld1() As String, feld2() As String, LListe1() As Variant, LListe2() As Variant
Public letzte As Long, FListe1() As Variant, FListe2() As Variant, Ws As Worksheet
Public Sub Filterstart()
Dim Zeile1 As Long, Zeile2 As Long
ReDim FListe1(letzte)
ReDim FListe2(letzte)
For Zeile1 = 14 To letzte - 13
If Not Rows(Zeile1).Hidden Then
Zeile2 = Zeile2 + 1
FListe1(Zeile2) = Ws.Cells(Zeile1, 3)
End If
Next
Zeile2 = 0
For Zeile1 = 14 To letzte - 13
If Not Rows(Zeile1).Hidden Then
Zeile2 = Zeile2 + 1
FListe2(Zeile2) = Ws.Cells(Zeile1, 8)
End If
Next
Zeile2 = 0
Call sortieren(1, UBound(FListe1), 1)
Call sortieren(1, UBound(FListe2), 2)
For Zeile1 = 1 To UBound(FListe1)
If FListe1(Zeile1) <> "" And FListe1(Zeile1) <> Empty Then
Zeile2 = Zeile2 + 1
ReDim Preserve feld1(Zeile2)
feld1(Zeile2) = FListe1(Zeile1)
If Zeile2 > 1 Then
If feld1(Zeile2 - 1) = feld1(Zeile2) Then
Zeile2 = Zeile2 - 1
ReDim Preserve feld1(Zeile2)
End If
End If
End If
Next
Zeile2 = 0
For Zeile1 = 1 To UBound(FListe2)
If FListe2(Zeile1) <> "" And FListe2(Zeile1) <> Empty Then
Zeile2 = Zeile2 + 1
ReDim Preserve feld2(Zeile2)
feld2(Zeile2) = FListe2(Zeile1)
If Zeile2 > 1 Then
If feld2(Zeile2 - 1) = feld2(Zeile2) Then
Zeile2 = Zeile2 - 1
ReDim Preserve feld2(Zeile2)
End If
End If
End If
Next
Worksheets(1).ComboBox1.List = feld1
Worksheets(1).ComboBox1.AddItem "alle", 0
Worksheets(1).ComboBox2.List = feld2
Worksheets(1).ComboBox2.AddItem "alle", 0
End Sub
Private Sub sortieren(Untergrenze As Long, Obergrenze As Long, liste As Integer)
Dim index1 As Long, index2 As Long, Element As String, Zwischenspeicher As String
index1 = Untergrenze
index2 = Obergrenze
If liste = 1 Then
Zwischenspeicher = FListe1(((Untergrenze + Obergrenze) / 2) \ 1)
Else
Zwischenspeicher = FListe2(((Untergrenze + Obergrenze) / 2) \ 1)
End If
Do
If liste = 1 Then
Do While FListe1(index1) < Zwischenspeicher
index1 = index1 + 1
Loop
Do While Zwischenspeicher < FListe1(index2)
index2 = index2 - 1
Loop
Else
Do While FListe2(index1) < Zwischenspeicher
index1 = index1 + 1
Loop
Do While Zwischenspeicher < FListe2(index2)
index2 = index2 - 1
Loop
End If
If index1 <= index2 Then
If liste = 1 Then
Element = FListe1(index1)
FListe1(index1) = FListe1(index2)
FListe1(index2) = Element
Else
Element = FListe2(index1)
FListe2(index1) = FListe2(index2)
FListe2(index2) = Element
End If
index1 = index1 + 1
index2 = index2 - 1
End If
Loop Until index1 > index2
If Untergrenze < index2 Then Call sortieren(Untergrenze, index2, liste)
If index1 < Obergrenze Then Call sortieren(index1, Obergrenze, liste)
End Sub