AW: Verknüpftes Dropdown / Auswahl
23.11.2020 21:06:32
volti
Hallo,
die Füllung so einer DropDownbox kannst Du z.B. mit VBA durchführen
Zunächst sammelst Du die gewünschten DropDown-Einträge je einmalig in einem String oder in einem Array oder, wenn sortiert gewünscht, z.B. in einer Collection.
Dann übergibst Du diese Daten entweder direkt als Werte an die Datenüberprüfungs-DropDown oder speicherst sie irgendwo, z.B. in einem ausgeblendetem Blatt und passt die Referenz darauf an.
Hat man nur wenige Daten, bietet sich die Direktwerte-Version an. Bei sehr vielen Daten muss man die DropDownbox(en) vor der Speicherung löschen und bei Neustart der Arbeitsmappe wieder neu aufbauen.
Sonst kann es bei zu vielen Daten zu Excelabstürzen kommen.
Oder man nimmt eine Hilfsspalte oder noch besser eine Hilfstabelle (kann man auch ausblenden) in der die gefilterten Daten vorliegen und setzt seine Referenz darauf.
Hierzu eine Idee als Beispiel dazu:
Code:
[Cc][+][-]
Option Explicit
Sub Test()
With ThisWorkbook.Worksheets("Tabelle6")
'B2=Ziel DropDown, B1=Quelle Filter=Lieferant '<<<anpassen>>>
SetDropDown .Range("B2"), .Range("B1").Value
End With
End Sub
Sub SetDropDown(oZiel As Range, Optional sFilter As String = "*")
'DropDown gefiltert setzen
'Mit Hilfsblatt über Referenzen
Dim WSh1 As Worksheet, WSh2 As Worksheet
Dim iZeile As Long, sData As String
Dim sArr() As String, iSpalte As Integer
Set WSh1 = ThisWorkbook.Worksheets("Daten") 'Datenblatt <<<anpassen>>>
Set WSh2 = ThisWorkbook.Worksheets("Hilfsblatt") 'Hilfsblatt <<<anpassen>>>
iSpalte = 2 'Ansprechpartner aus Spalte "B"
'Items nur einmalig in einen String aufnehmen
sData = ","
For iZeile = 1 To WSh1.Cells(Rows.Count, iSpalte).End(xlUp).Row
With WSh1.Cells(iZeile, iSpalte)
If .Offset(0, -1).Value Like sFilter Then
If InStr(sData, "," & .Value & ",") = 0 Then sData = sData & .Value & ","
End If
End With
Next iZeile
'Daten aufbereitet in Array überführen und auf Hilfsblatt ausgeben
sData = Mid$(sData, 2)
If Len(sData) > 2 Then sData = Left$(sData, Len(sData) - 1)
sArr = Split(sData, ",")
If UBound(sArr) >= 0 Then
WSh2.Range("A1").Resize(UBound(sArr) + 1, 1) = Application.Transpose(sArr)
'Comboxbox in B2 anpassen
With oZiel.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, _
Formula1:="=" & WSh2.Name & "!" & WSh2.Range("A1").Resize(UBound(sArr) + 1, 1).Address
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End If
End Sub
_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz