Tabelle filtern mittels Objekten
16.06.2017 10:13:51
Fxyz
ich komme bei einer Excel / VBA - Programmierung irgendwie nicht weiter bzw. stehe auf dem Schlauch und auch die Google Suche konnte mir nich wirklich weiterhelfen.
Folgende Aufgabe:
Ich habe in einem Reiter eine Art "Datenbank" in der in einer Liste verschiedene Informationen stehen.
Auf dem ersten Reiter "Auswahl" möchte ich mittels "Drop-Down-ActiveX" Elementen diese Tabelle durchsuchen. Dabei soll möglichst flexibel eine der Spalten mit diesen Objekten gefiltert werden können, die anderen sollen dann die noch möglichen Werte anzeigen und auch wieder Filtermöglichkeiten ergeben (also eigentlich eine klassische Filterung der Tabelle nur mittels Dropdown - Objekten).
Ich habe erstmal einfach angefangen und habe versucht nacheinander die Spalten zu filtern. Das funktioniert so weit auch ganz gut, dass wenn ich aus A etwas auswähle, nur die Werte in B angezeigt werden, die möglich sind. Nun wähle ich in B etwas aus aber in C wird nichts mehr angezeigt und ich verstehe nicht warum nicht...
Zusätzliche Randbedingungen:
- Keine doppelten Werte sollen angezeigt werden
- Sortierung der angezeigten Werte (noch nicht realisiert)
Könnt ihr mir weiterhelfen?
hier ist meine Beispieldatei: https://www.herber.de/bbs/user/114306.xlsm
anbei der VBA Code:
Option Explicit
Dim s As Integer
Private Sub ComboBox1_Change()
Dim rCell As Range, Key
Dim Dic As Object: Set Dic = CreateObject("Scripting.Dictionary")
ComboBox2.Clear
For Each rCell In Worksheets("Datenbank").Range("A2", Worksheets("Datenbank").Cells(Rows. _
Count, "A").End(xlUp))
If rCell.Value = ComboBox1.Value Then
If Not Dic.exists(LCase(rCell.Offset(, 1).Value)) Then
Dic.Add LCase(rCell.Offset(, 1).Value), Nothing
End If
End If
Next rCell
For Each Key In Dic
ComboBox2.AddItem Key
Next
End Sub
Private Sub ComboBox2_Change()
Dim rCell As Range, Key
Dim Dic2 As Object: Set Dic2 = CreateObject("Scripting.Dictionary")
ComboBox3.Clear
For Each rCell In Worksheets("Datenbank").Range("B2", Worksheets("Datenbank").Cells(Rows. _
Count, "B").End(xlUp))
If rCell.Value = ComboBox2.Value Then
If Not Dic2.exists(LCase(rCell.Offset(, 2).Value)) Then
Dic2.Add LCase(rCell.Offset(, 2).Value), Nothing
End If
End If
Next rCell
For Each Key In Dic2
ComboBox3.AddItem Key
Next
End Sub
Private Sub Worksheet_Activate()
ComboBox1.Clear
For s = 3 To Worksheets("Datenbank").Range("A65536").End(xlUp).Row
If Worksheets("Datenbank").Cells(s, 1).Value "" Then
If Application.WorksheetFunction.CountIf(Worksheets("Datenbank").Range(Worksheets(" _
Datenbank").Cells(s, 1), _
Worksheets("Datenbank").Cells(1, 1)), Worksheets("Datenbank").Cells(s, 1).Value) = 1 _
Then ComboBox1.AddItem (Worksheets("Datenbank").Cells(s, 1).Value)
End If
Next
End Sub