Aufruf einer Listbox_Change
14.02.2021 10:51:11
Gerd
ich habe zwei Listboxen. In der einen (Listbox 1) stehen Werte und in der anderen (Listbox 2) wähle ich Zuordnungen aus. Beim Wechseln der Werte in Listbox 1 will ich die zugehörigen Werte in (Listbox 2) als selected markieren. Dazu frage ich die vorhandenen Werte aus einem Worksheet ab. Die Auswahl in Listbox 2 frage ich mit Hilfe eines Change-Events ab.
Leider springt die Abfrageroutine beim Ändern eines Wertes immer in den Change-Prozess. Ich habe im Internet Application.EnableEvents gefunden. leider funktioniert das nicht.
Die beiden Routinen haben ich als Text beigefügt. Unabhängig voneinander machen beide Routinen was sie sollen, nur in Verbindung werden die "nicht markierten" Elemente vom Arbeitsblatt gelöscht, bevor alle eingetragen werden können.
Ich hoffe, es weiß jemand Rat.
Viele Grüße
Gerd
Deklaration:
LBFachbereich (Listbox 2): für die Selektierung der Werte
LBAIndex (Listbox 1): für die ausgewählte Liste zur der die Werte aus Listbox 2 gehören
Sheets("Inhalt").Cells(z, 3): Auslesen eines Indexwertes
Sheets("Fachbereich").Cells(i,1): Eingetragener Indexwert von Inhalt
Sheets("Fachbereich").Cells(i,2): Eingetragener Wert aus Listbox 2
Sub FBAuswahl()
Dim LBAIndex As String
Dim x, z As Integer
'Index auslesen
For z = 2 To Sheets("Inhalt").Cells(Rows.Count, 1).End(xlUp).Row
If (Sheets("Inhalt").Cells(z, 1) = LBTopic.Value) And (Sheets("Inhalt").Cells(z, 2) = _
_
LBInhalt.Value) Then
LBAIndex = Sheets("Inhalt").Cells(z, 3)
End If
Next z
For z = 2 To Sheets("Fachbereich").Cells(Rows.Count, 1).End(xlUp).Row
If Sheets("Fachbereich").Cells(z, 1) = LBAIndex Then
For x = 0 To LBFachbereich.ListCount - 1
If Sheets("Fachbereich").Cells(z, 2) = LBFachbereich.List(x) Then
LBFachbereich.Selected(x) = True
End If
Next x
End If
Next z
End Sub
Sub LBFachbereich_Change()
Dim Zeile, i, j, Zaehler As Integer
Dim Index As String
Dim Vorhanden As Boolean
Zaehler = 2
Zeile = 0
'Hier wird abgefragt, ob ob in der Ausgangstabelle ein Eintrag besteht
For i = 2 To Sheets("Inhalt").Cells(Rows.Count, 1).End(xlUp).Row
If Sheets("Inhalt").Cells(i, 1) = LBTopic.Value And Sheets("Inhalt").Cells(i, 2) = _
LBInhalt.Value Then
Zeile = Zaehler
Index = Sheets("Inhalt").Cells(i, 3)
End If
Zaehler = Zaehler + 1
Next i
'Hier wird abgefragt, ob der Wert in der Listbox 2 markiert ist oder nicht
If Zeile > 0 Then
For i = 0 To LBFachbereich.ListCount - 1
Vorhanden = False
With Sheets("Fachbereich")
' Ist der Wert nicht markiert und ein Wert vorhanden, wird die Zeile gelöscht
If LBFachbereich.Selected(i) = False Then
For j = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
If .Cells(j, 1) = Index And LBFachbereich.List(i) = .Cells(j, 2) Then
.Rows(j).Delete Shift:=xlUp
End If
Next j
Else
' Ist der Wert markiert und kein Wert vorhanden,wird ein neuer angelegt
For j = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
If .Cells(j, 1) = Index And LBFachbereich.List(i) = .Cells(j, 2) Then
Vorhanden = True
End If
Next j
If Vorhanden = False Then
.Cells(.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1) = Index
.Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 2) = LBFachbereich.List(i)
Vorhanden = False
End If
End If
End With
Next i
End If
End Sub