Mehrere Ergebnisse als DropDown darst.?

Hallo zusammen,
ich bitte um etwas Hilfe zu folgender Fragestellung:
''Produkt'' (= definierter Bereich) aus TB1 vereinfacht dargestellt:
Nr. Artikel Daten
1 Banane gelb
2 Banane grün
Bisher ist es so: Wenn ich in TB2 in Zelle A1 eine Nummer eingebe, zieht B1 sich automatisch den Artikel aus ''Produkt''. Jetzt gibt es einige Artikel allerdings häufiger - daher würde ich die Sache gern umstellen:
Ich gebe den Artikel ein und dann soll C1 nicht nur die erste entsprechende Zelle aus ''Produkt'' ausspucken - das tut es -, sondern auch
a.) merken, wenn der Artikel mehr als einmal in ''Produkt'' vorkommt und
b.) dann bestenfalls eine Drop-Down-Liste der entsprechenden Zellen ausspucken (Banane in B1 = Drop-Down "gelb; grün" in C1).
Hat jemand einen Ansatz für mich? Geht das überhaupt mit INDEX (als Quelle)?
Danke!
Janine

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Moin,
ganz einfach ist es nicht.
Was Du möchtest, die Dropdown-Liste, ist mit "Datenüberprüfung" zu haben. Diese ist per Hand unter Menü "Daten", "Datenüberprüfung" zu haben.
Nun sollte diese Auswahlilste in Spalte C sich jedesmal ändern, wenn in Spalte B bzw. A einen neuen Wert eingetragen wird.
d.h., bei Änderung in TB2!Ax
_ Wert in TB2!Bx lesen
_ neue Liste auf Basis von TB1, Spalte B als Filter, Spalte C als Werte für die Liste
_ Liste als Datenüberprüfung in TB2!Cx setzen
Auf dem Reiter vom Blatt TB2 rechtklicken und "Code anzeigen" auswählen. Dort folgende Code copy-pasten und eventuell BlattName in "Eigenschaften_auflisten" anpassen:


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Z As Range
Dim Erg
Application.EnableEvents = False
For Each Z In Target.Cells
If Z.Column = 2 Then 'nur Spalte 2 "B"
With Z.Offset(0, 1)
Erg = Eigenschaften_auflisten(Z.Value)
.Validation.Delete
.ClearContents
If UBound(Erg) >= 0 Then .Validation.Add Type:=xlValidateList, Formula1:=Join(Erg, ",")
End With
End If
Next
Application.EnableEvents = True
End Sub
Private Function Eigenschaften_auflisten(ByVal Filter As String)
Dim D As Object 'Dictionary. Listet alle Einträge nur einmal (Eindeutig)
Dim Z As Range 'Objekt für einzelne Zelle
Const cBlattName = "TB1"
Filter = LCase(Filter)  'Filter aus Kleinschreibung umstellen
Set D = CreateObject("Scripting.Dictionary")
With Worksheets(cBlattName)
For Each Z In Range(.Range("B2"), .Cells(.Rows.Count).End(xlUp))
If LCase(Z.Value) = Filter Then D(Z.Offset(1, 0).Value) = 1
Next
End With
Eigenschaften_auflisten = Array() 'Default-Value
If D.Count > 0 Then Eigenschaften_auflisten = D.Keys
End Function

VG
Yal

Beliebteste Forumthreads (12 Monate)

Mehrere Ergebnisse als DropDown darst.?

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread