Ort aus Postleitzahl braucht zu viele Ressourcen
01.11.2015 20:31:30
Sabrina
Ich habe folgende Methode als "Private Sub Worksheet_Change(ByVal Target As Range)"
Das Problem ist dass zu viele Ressourcen verbraucht werden.
Da ja bei jeder Eingabe in einem Feld die Methode ausgeführt wird.
Hat jemand eine Idee wie man dies effektiver lösen kann?
Ich habe noch andere dinge in der Methode drinnen ... es dauert leider sehr lange.
Hier die Test Datei
https://www.herber.de/bbs/user/101179.xls
Gruß Sabbel
Hier die Methode
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim ort_wahl As Long
ort_wahl = Range("ort_wahl")
' Ort suche
Application.EnableEvents = True
Dim arr As Variant
Dim iCounter, Zähler As Long
If Not Target.Address(0, 0) = "PLZ" Then
If Not Intersect(Target, Range("PLZ")) Is Nothing Then
If Range("ORT_wahl") = 3 Then
Exit Sub
Else
Range("PLZ_wahl") = 3
UF1.ListBox1.Clear
arr = Workbooks("PLZ.xls").Worksheets("ORT").Range("B2").CurrentRegion.Value
For iCounter = 1 To UBound(arr)
If UCase(arr(iCounter, 2)) = UCase(Target) Then
UF1.ListBox1.AddItem arr(iCounter, 3)
Zähler = Zähler + 1
End If
Next
If Zähler = 0 Then
MsgBox " Diese PLZ existiert nicht"
Range("A4").ClearContents
Exit Sub
End If
If Zähler = 1 Then
Range("Ort").Value = UF1.ListBox1.List
Else
UF1.Show
End If
End If
End If
End If
' PLZ suche
If Not Intersect(Target, Range("Ort")) Is Nothing Then
If Range("PLZ_wahl") = 3 Then
Exit Sub
Else
Range("ort_wahl") = 3
UF2.ListBox1.Clear
arr = Workbooks("PLZ.xls").Worksheets("ORT").Range("A2").CurrentRegion.Value
For iCounter = 1 To UBound(arr)
If UCase(arr(iCounter, 1)) = UCase(Target) Then
UF2.ListBox1.AddItem arr(iCounter, 2)
Zähler = Zähler + 1
End If
Next
If Zähler = 0 Then
MsgBox " Dieser Ort existiert nicht"
Range("B4").ClearContents
Exit Sub
End If
If Zähler = 1 Then
Range("PLZ").Value = UF2.ListBox1.List
Else
UF2.Show
End If
End If
End If
Application.EnableEvents = True
End Sub