AW: ListBox1-Auswahl - Werte an Listbox2 übergeben
26.07.2019 12:56:07
Richard
Hallo Andreas,
bin zwar auch ein Anfänger habe aber unter diesem tollen Forum auch schon oft Hilfe bekommen (echt toll)
hier mein Code für 2er Combobox voneinander abhängig. Musst Dir auf Deine Liste anpassen Spaltenzahl und so
Option Explicit
Private arrData As Variant
Private wksData As Worksheet
Private arrList As Variant
Private Sub AuswahlListecombo1() 'Auswalliste für Combo1 aktualisieren
Dim hshA As Object
Dim i As Long
Dim varcombo2
Set hshA = CreateObject("Scripting.Dictionary")
varcombo2 = Me.cbb2.Text
For i = LBound(arrList) To UBound(arrList)
If (varcombo2 = "" Or varcombo2 = arrList(i, 6)) Then hshA(CStr(arrList(i, 1))) = 0
Next
'Auswahlliste der Combobox zuweisen
Me.cbb1.List = hshA.keys
Set hshA = Nothing
End Sub
Sub AuswahlListecombo2() 'Auswalliste für Combo2 aktualisieren
Dim hshA As Object
Dim i As Long
Dim varcombo1
Set hshA = CreateObject("Scripting.Dictionary")
varcombo1 = Me.cbb1.Text
For i = LBound(arrList) To UBound(arrList)
If (varcombo1 = "" Or varcombo1 = arrList(i, 1)) Then hshA(CStr(arrList(i, 6))) = 0
Next
'Auswahlliste der Combobox zuweisen
Me.cbb2.List = hshA.keys
Set hshA = Nothing
End Sub
Private Sub Auswahl_Reset()
'Auswahl für Comboboxen zurücksetzen
'Listbox formatieren und alle Daten zuweisen
arrList = arrData
With Me.lst1
.Clear
.List = arrList
.ListIndex = 0
End With
Me.cbb1.ListIndex = -1
Me.cbb2.ListIndex = -1
Call AuswahlListecombo1
Call AuswahlListecombo2
End Sub
Private Sub Listbox_fuellen()
'Daten für Listbox zusammenstellen
Dim AnzTreffer As Long
Dim hshA As Object
Dim i As Long
Dim Zeile As Long, Spalte As Long
Dim varcombo1, varcombo2, varKey
Set hshA = CreateObject("Scripting.Dictionary")
varcombo1 = Me.cbb1.Text
varcombo2 = Me.cbb2.Text
AnzTreffer = 0
For i = LBound(arrData, 1) To UBound(arrData, 1)
If (varcombo1 = "" Or varcombo1 = arrData(i, 1)) Then
If (varcombo2 = "" Or varcombo2 = arrData(i, 6)) Then
AnzTreffer = AnzTreffer + 1
hshA(CStr(i)) = 0
End If
End If
Next
Me.lst1.Clear
If AnzTreffer > 0 Then
ReDim arrList(1 To AnzTreffer, LBound(arrData, 2) To UBound(arrData, 2))
AnzTreffer = 0
For Each varKey In hshA.keys
Zeile = Val(varKey)
AnzTreffer = AnzTreffer + 1
For Spalte = LBound(arrData, 2) To UBound(arrData, 2)
arrList(AnzTreffer, Spalte) = arrData(Zeile, Spalte)
Next
Next
With Me.lst1
.List = arrList
.ListIndex = 0
End With
End If
Set hshA = Nothing
End Sub
Private Sub cbb1_Change()
'ADM wurde ausgewählt
If Me.cbb1.ListIndex = -1 Then Exit Sub
Call Listbox_fuellen
Call AuswahlListecombo2
End Sub
Private Sub cbb2_Change()
'Ort wurde ausgewählt
If Me.cbb2.ListIndex = -1 Then Exit Sub
Call Listbox_fuellen
Call AuswahlListecombo1
End Sub
Private Sub cmdBeenden_Click()
Erase arrList, arrData
Set wksData = Nothing
Unload Me
End Sub
Private Sub cmdloeschen_Click()
Dim lZeile As Long
'Wenn kein Datensatz in der ListBox markiert wurde, wird die Routine beendet
If ListBox1.ListIndex = -1 Then Exit Sub
'Zum Löschen benötigen wir die Zeilennummer des ausgewählten Datensatzes
lZeile = 2 'Start in Zeile 2, Zeile 1 sind ja die Überschriftrn
'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
Do While Trim(CStr(Tabelle1.Cells(lZeile, 1).Value)) ""
'Datensatz ID Spalte mit selektiertem Eintrag der ListBox vergleichen
If ListBox1.Text = Trim(CStr(Tabelle1.Cells(lZeile, 1).Value)) Then
'Eintrag gefunden, die ganze Zeile wird nun gelöscht
Tabelle1.Rows(CStr(lZeile & ":" & lZeile)).Delete 'Delete
'Die ListBox muss nun neu geladen werden!
Call UserForm_Initialize
If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
Exit Do 'Vorzeitiges Ende, da der Datensatz schon gefunden ist
End If
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
End Sub
Private Sub cmdneueAbfrage_Click()
Call Auswahl_Reset
End Sub
Private Sub UserForm_Initialize()
Dim Zeile_L As Long
Dim i As Long
'Tabellenblatt mit den Daten einer modulweiten Variablen zuweisen
Set wksData = ThisWorkbook.Sheets("Tabelle1")
With wksData
'letzte Zeile mit Daten in Spalte A des Tabellenblatts
Zeile_L = .Cells(.Rows.Count, 1).End(xlUp).Row
'Daten (Spalten A:G) im Tabellenblatt in ein Daten-Array übernehmen ohne Spaltentitel _
und miteiner Leerspalte für die Zeilennummer
arrData = .Range(.Cells(2, 1), .Cells(Zeile_L, 6))
'alle Daten der Auswahlliste zuweisen
arrList = arrData
End With
'Listbox formatieren
With Me.lst1
.ColumnCount = 6
.ColumnHeads = False
.ColumnWidths = "20Pt;20Pt;180Pt;100Pt;30Pt;50Pt;"
End With
Call Auswahl_Reset
End Sub
Gruß Richard