Nummer einer PLZ zuordnen mit "Case"

19.11.2024 20:06:35

Eisi

https://www.herber.de/bbs/user/173714.xlsm

Hallo zusammen,
vor Jahren hatte ich hier den Code von Euch bekommen. Hat bis jetzt top funktioniert.
Ich habe den Code im Blatt "CodeToPLZ" angepasst wie jedes Jahr und das Makro gestartet.
Meine internen Codes 1 bis 24 werden aber nicht richtig den PLZ (Format: Postleitzahl) zugeordnet.
PLZ 01099 = 2 passt, aber PLZ 01108 = ohne Zuweisung.
So auch bei PLZ 53949 = 20 passt, aber PLZ 54290 = ohne Zuweisung. Da gibt es viele solcher Beispiele in meiner Mappe im Anhang.
Zum allgemeinen Verständnis:
Jedes Jahr habe ich eine Zuordnung im Sheet: DatenQuelle und diese Codes muss ich per Case im Code per Hand jedes mal ändern. Damit es einfacher geht, habe ich die Sheets: PLZGeordnet und PLZCase mit dazu eingebaut. Dann brauche ich die Daten für Case nur noch mit einem Klick kopieren und kann das in das Makro einfügen.

Was ist falsch an dem Makro?

Eine Hilfe wäre super nett.

VG Eisi :-)

AW: Nummer einer PLZ zuordnen mit "Case"

19.11.2024 20:41:55

Onur

Bevor wir anfangen müssen, das Makro zu analysieren: was genau soll es denn überhaupt machen ?

AW: Nummer einer PLZ zuordnen mit "Case"

20.11.2024 10:31:35

Eisi

Hallo Onur,

danke für Deine Hilfe :-)

Die Lösung vom Udo passt perfekt.

GLG Eisi :-)

AW: Nummer einer PLZ zuordnen mit "Case"

19.11.2024 21:12:17

Uduuh

Hallo,
ein Versuch:

Sub PLZ2Code()

  Dim objPlzCode As Object

  Dim vntIN, vntOUT

  Dim i As Long, lngPLZ As Long

  Set objPlzCode = CreateObject("scripting.dictionary")

  

  With Sheets("plzgeordnet")

    vntIN = .Range(.Cells(2, 1), .Cells(Rows.Count, 2).End(xlUp))

  End With

  

  For i = 1 To UBound(vntIN)

    Select Case Len(vntIN(i, 2))

      Case 1, 2

        For lngPLZ = vntIN(i, 2) * 1000 To vntIN(i, 2) * 1000 + 999

          objPlzCode(lngPLZ) = vntIN(i, 1)

        Next lngPLZ

      Case 3

        For lngPLZ = vntIN(i, 2) * 100 To vntIN(i, 2) * 100 + 99

          objPlzCode(lngPLZ) = vntIN(i, 1)

        Next lngPLZ

      Case 4

        For lngPLZ = vntIN(i, 2) * 10 To vntIN(i, 2) * 10 + 9

          objPlzCode(lngPLZ) = vntIN(i, 1)

        Next lngPLZ

      Case 5

        objPlzCode(vntIN(i, 2)) = vntIN(i, 1)

    End Select

  Next i

  

  With Sheets("codetoplz")

    vntOUT = .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp).Offset(, 1))

    For i = 1 To UBound(vntOUT)

      vntOUT(i, 2) = objPlzCode(vntOUT(i, 1))

    Next i

    .Cells(2, 1).Resize(UBound(vntOUT), 2) = vntOUT

  End With

  

End Sub

54XXX hat keinen Code.

Gruß aus'm Pott
Udo

AW: Nummer einer PLZ zuordnen mit "Case"

20.11.2024 10:45:20

daniel

Hi

es ist mir jetzt zu mühsam, deinen Code zu analysieren.
daher hier mein Versuch.

Sub PLZ_Zuordnen()



Dim arrGesamt

Dim arrPLZ



Dim z As Long

Dim PLZ

Dim dicPLZ As Object

Dim P As Long





Set dicPLZ = CreateObject("scripting.dictionary")



'--- step 1 --- PLZ-Codes einlesen

arrGesamt = Sheets("DatenQuelle").Cells(1, 1).CurrentRegion.Value

For z = 2 To UBound(arrGesamt)

    For Each PLZ In Split(arrGesamt(z, 2), ",")

        PLZ = Replace(PLZ, " ", "")

        If PLZ Like "*-*" Then

            For P = Split(PLZ, "-")(0) To Split(PLZ, "-")(1)

                dicPLZ(CStr(P)) = arrGesamt(z, 1)

            Next

        Else

            dicPLZ(PLZ) = arrGesamt(z, 1)

        End If

    Next

Next



'--- Step 2 --- Plz nach länge sortieren

With Sheets("DatenQuelle").Range("F1").Resize(dicPLZ.Count, 3)

    .Columns(1).NumberFormat = "@"

    .Columns(1).Formula = WorksheetFunction.Transpose(dicPLZ.keys)

    .Columns(2).Formula = WorksheetFunction.Transpose(dicPLZ.items)

    .Columns(3).FormulaR1C1 = "=len(RC[-2])"

    .Sort key1:=.Cells(1, 3), order1:=xlDescending, key2:=.Cells(1, 1), order2:=xlAscending, Header:=xlNo

    arrPLZ = .Value

    .ClearContents

End With



'-- step 3 - Codes zuweisen

With Sheets("CodeToPLZ").Cells(1, 1).CurrentRegion

    arrGesamt = .Value

    For z = 2 To UBound(arrGesamt)

        arrGesamt(z, 1) = Format(arrGesamt(z, 1), "00000")

        arrGesamt(z, 2) = ""

        For P = 1 To UBound(arrPLZ, 1)

            If arrGesamt(z, 1) Like arrPLZ(P, 1) & "*" Then

                arrGesamt(z, 2) = arrPLZ(P, 2)

                Exit For

            End If

        Next

    Next

    .Value = arrGesamt

End With



End Sub

der entscheidende Schritt ist, dass einzelnen PLZ-Gebiete zuerst nach Länge des Textes sortiert werden, damit die längeren PLZ Gebiete Priorisiert werden.
dh das Gebiet 88149 bekommt die 18, diese Zuweisung darf nicht von von der 9 für das PLZ-Gebiet 88 überschrieben werden.
Daher ist hier die Reihenfolge nach Länge wichtig.

ein weiterer Punkt, den du bei meinem Code beachten musst:
du hast manche Gebiete als "von-bis" definiert ("155-159").
da ich diese per Schleife in Einzelgebiete auflöse (155, 156, 157, 158, 159), funktioniert das nur für PLZ-Gebiete, die nicht mit 0 beginnen.
dh ein "012-017" wäre nicht zulässig und du müsstest das von Hand einzeln aufführen.

Gruß Daniel

AW: Nummer einer PLZ zuordnen mit "Case"

20.11.2024 16:11:30

Eisi

Herzlichen Dank für Deine Hilfe.
GLG Eisi :-)

AW: Nummer einer PLZ zuordnen mit "Case"

20.11.2024 11:32:59

Yal

Moin,

Anbei eine Lösung ohne VBA:
- Aufdröseln der "DatenQuelle" mit Power Query (als Ersatz zu "PLZGeordnet", die -so weit ich beurteilen kann- fehlerhaft ist. )
- INDEX+VERGLEICH um den nähest-niedrigste PLZ zuzuordnen

Erst den Code von Udo hat mich auf die Fragestellung aufmerksam gemacht.

Vorgehensweise:
- Filter in "DatenQuelle" rausnehmen,
- Zelle A1 markieren
- Menü "Einfügen", "Tabelle". Umfang und Überschrift werden erkannt
- im Menü "Tabellenentwurf", Name in "DatenQuelle" ändern (nicht wichtig, ausser für diese Anleitung)
- Menü "Daten", "Aus Tabelle/Bereich"
- Du bist in Power Query Editor
- Rechts in der Abfrageeigenschaften, Name der Abfrage in "PLZGeordnet" ändern
- Überschrift der Spalte "PLZGebiete" rechtsklicken und "Werte ersetzen" wählen, Leerzeichen durch nichts ersetzen,
- Spalte ist bereits markiert, Menü "Transformieren", "Spalte teilen", teilen nach Komma, in "Erweiterte Optionen", Aufteilen in Zeilen
- normal mit "-", auch in Zeilen
- Menü "Spalte hinzufügen", "benutzerdefinierte Spalte", Spaltename "5-stellig", Formel
=Text.Start([PLZGebiete]&"0000",5)
- Spalte "5-stellig" im Überschrift rechtsklicken, "Typ ändern", "Text" setzen
- Spalte aufsteigend sortieren (wichtig für Excel-Formel Vergleich)
- Menü "Datei", "Schliessen & laden in...", in bestehendes Arbeitsblatt "PLZGeordnet" in F1 ausgeben
Es fügt sich eine Ausgabetabelle, die "PLZGeordnet" heisst.

Da kann man schon sehen welche Unreinheiten in der originale Liste vorhanden sind. Vielleicht muss man für die alte Liste auch mit einer 5-.stelligen PLZ ergänzen:
=WERT(LINKS(B2&"00000";5))
und nach dem Ergebnis sortieren.
u.a. 15299, Code 2, befindet sich im Bereich 152-153, Code 6.

Dann nur noch im Arbeitsblatt "CodeToPLZ" die Formeln
=INDEX(PLZGeordnet[Code];VERGLEICH(TEXT(A2;"00000");PLZGeordnet[5-Stellig];1);1)
in C2 und
=INDEX(PLZGeordnet[PLZGebiete];VERGLEICH(TEXT(A2;"00000");PLZGeordnet[5-Stellig];1);1)
in D2 (nur zur Kontroll)
und nach unten erweitert.

VG
Yal

AW: Nummer einer PLZ zuordnen mit "Case"

20.11.2024 16:15:49

Eisi

Herzlichen Dank für Deine Hilfe.
Auch ein interessanter Ansatz. Muss mich da etwas tiefer eindenken.
GLG Eisi :-)

AW: Nummer einer PLZ zuordnen mit "Case"

20.11.2024 10:28:46

Eisi

Hallo Udo,

echt eine Traumlösung, funktioniert perfekt und ich brauch in Zukunft am Code eigentlich nichts mehr verändern.

Herzlichen Dank für die super gute und schnelle Hilfe.
Ich weiß, dass das keine Selbstverständlichkeit ist so eine Antwort zu bekommen.

Ach ja, der Pott, meine alte Heimat, komme aus der Gegend Herne Holzhausen.

GLG Eisi :-)

Nummer einer PLZ zuordnen mit "Case"

Forumthread: Nummer einer PLZ zuordnen mit "Case"

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Nummer einer PLZ zuordnen mit "Case"

Forumthread: Nummer einer PLZ zuordnen mit "Case"

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread