Tabelle durch Zelldropdownfeld filtern

[T.Catt]

[
Bild bitte so als Datei hochladen: Klick mich!
]

Hallo zusammen,
kann mir hier geholfen werden

Problembeschreibung:
Ich habe eine Wertetabelle mit verschiedenen Beschreibungen. A4:H50
In der Zelle C2 habe ich eine Zellendropdownliste mit drei Werten A,B,C. Durch diese Zellendropdownliste möchte ich nun die Tabelle filtern. 
Relevant für das Filtern sind die Spalten F:H.
Wird nun A in der Dropdownliste ausgewählt, sollen nur die Zeilen angezeigt werden die in Spalte F mit einem A vermerkt sind.
Wird nach B gefiltert, sollen nur die Zeilen angezeigt werden die in Spalte G mit einem B vermerkt sind. 
Wird nach C gefiltert, sollen nur die Zeilen angezeigt werden die in Spalte H mit einem F vermerkt sind. 

Viele Grüße
T.Catt

[Kuwer]

Hallo Tobias,

folgender Code kommt in das schon vorhandene VBA-Modul des entsprechenden Tabellenblattes:

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim rngF As Range
 If Target.Address = "$C$2" Then
   Set rngF = Range("A1").CurrentRegion
   Set rngF = rngF.Offset(2, 5).Resize(rngF.Rows.Count - 2, 3)
   Select Case Target.Value
     Case "A"
       rngF.AutoFilter Field:=2, VisibleDropDown:=False
       rngF.AutoFilter Field:=3, VisibleDropDown:=False
       rngF.AutoFilter Field:=1, Criteria1:="=A", VisibleDropDown:=False
     Case "B"
       rngF.AutoFilter Field:=1, VisibleDropDown:=False
       rngF.AutoFilter Field:=3, VisibleDropDown:=False
       rngF.AutoFilter Field:=2, Criteria1:="=B", VisibleDropDown:=False
     Case "C"
       rngF.AutoFilter Field:=1, VisibleDropDown:=False
       rngF.AutoFilter Field:=2, VisibleDropDown:=False
       rngF.AutoFilter Field:=3, Criteria1:="=C", VisibleDropDown:=False
     Case Else
       rngF.AutoFilter Field:=1, VisibleDropDown:=False
       rngF.AutoFilter Field:=2, VisibleDropDown:=False
       rngF.AutoFilter Field:=3, VisibleDropDown:=False
   End Select
 End If
End Sub

Die Datei muss mit der Endung .xlsm abgespeichert werden, weil VBA-Code enthalten ist.


  Beispiel_Kuwer.xlsm (Größe: 22,55 KB / Downloads: 6)

Gruß Uwe

[T.Catt]

Super funktioniert!
Besten Dank @Kuwer für die Hilfe.