AW: Danke .. funktioniert bestens .. weitere Option
15.04.2020 20:48:53
Sabrina
Ich habe es versucht so zu lösen .. es funktioniert auch.
Ist das okay so oder muss man es anders machen?
Private Sub Worksheet_Change(ByVal Target As Range)
' Ort suche
Dim arr As Variant
Dim iCounter, Zähler As Long
Application.EnableEvents = False
If Not Target.Address(0, 0) = "PLZ_Eingabe" Then
If Not Intersect(Target, Range("PLZ_Eingabe")) Is Nothing Then
If Ort_wahl = 3 Then
GoTo Beenden
Else
PLZ_wahl = 3
UF1.ListBox1.Clear
arr = Workbooks("PLZ.xlsm").Worksheets("ORT").Range("B2").CurrentRegion.Value
For iCounter = 1 To UBound(arr)
If UCase(arr(iCounter, 2)) = UCase(Target.Text) Then
UF1.ListBox1.AddItem arr(iCounter, 3)
Zähler = Zähler + 1
End If
Next
Select Case Zähler
Case 0
If Range("Ort_Eingabe") > "" Then
Range("D6").ClearContents
GoTo Beenden
End If
MsgBox " Diese PLZ existiert nicht"
Range("C6").ClearContents
GoTo Beenden
Case 1
Range("Ort_Eingabe").Value = UF1.ListBox1.List
Case Else
UF1.Show
End Select
PLZ_wahl = 1
End If
End If
End If
' PLZ suche
If Not Intersect(Target, Range("Ort_Eingabe")) Is Nothing Then
If Ort_wahl = 3 Then
Exit Sub
Else
Ort_wahl = 3
UF2.ListBox1.Clear
arr = Workbooks("PLZ.xlsm").Worksheets("ORT").Range("A2").CurrentRegion.Value
For iCounter = 1 To UBound(arr)
If UCase(arr(iCounter, 1)) = UCase(Target.Text) Then
UF2.ListBox1.AddItem arr(iCounter, 2)
Zähler = Zähler + 1
End If
Next
Select Case Zähler
Case 0
If Range("PLZ_Eingabe") > "" Then
Range("C6").ClearContents
GoTo Beenden
End If
MsgBox " Dieser Ort existiert nicht"
Range("D6").ClearContents
GoTo Beenden
Case 1
Range("PLZ_Eingabe").Value = UF2.ListBox1.List
Case Else
UF2.Show
End Select
Ort_wahl = 1
End If
End If
Beenden:
Application.EnableEvents = True
End Sub