Thema
Dynamische Postleitzahldatenbank
Gruppe
Change
Problem
Wie kann ich mir eine dynamische Postleitzahlendatenbank anlegen? Bei Eingabe einer bereits bekannten PLZ soll der zugehörige Ort eingetragen werden, ist die PLZ nicht bekannt, soll ein Dialog zur Ortseingabe aufgerufen und PLZ und Ort sollen in die PLZDatenbank eingetragen werden.
ClassModule: Tabelle2 Private Sub Worksheet_Change(ByVal Target As Range) Dim var As Variant Dim iRow As Integer Dim sOrt As String If Target.Column <> 1 Then Exit Sub Application.EnableEvents = False On Error GoTo ERRORHANDLER If IsEmpty(Target) Then Target.Offset(0, 1).ClearContents Exit Sub End If With Worksheets("PLZ") var = Application.Match(Target.Value, .Columns(1), 0) If Not IsError(var) Then Target.Offset(0, 1).Value = .Cells(var, 2).Value Else sOrt = InputBox("Bitte Ort eingeben:") If sOrt = "" Then Exit Sub iRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(iRow, 1).Value = Target.Value .Cells(iRow, 2).Value = sOrt Target.Offset(0, 1).Value = sOrt End If End With ERRORHANDLER: Application.EnableEvents = True End Sub