Postleitzahlen zusammenfügen und ungültige herausfiltern

[dennis1793]

Hallo zusammen! :15:
Mir liegt eine Excel-Liste mit Umsätzen nach Postleitzahlen vor. Nun habe ich folgendes Problem: Manche Postleitzahlen sind doppelt; sind unvollständig oder fehlerhaft.
Mein Ziel ist es ein Tabellen zu erstellen als Eingabe, also hier sollen meine vorliegenden Daten hereinkopiert werden. Auf dem Zweiten Tabellenblatt sollen die Daten
überarbeitet zur Verfügung stehen, sodass ich diese wieder entnehmen kann und damit weiterarbeiten kann.

Folgende Formatierungen benötige ich jetzt:
1. Doppelt vergebenen Postleitzahlen inklusive Umsatz zusammenfügen.
2. Ungültige Postleitzahlen herausfiltern und den Umsatz auf alle von mir vergebenen Postleizahlen verteilen.

So sieht die Tabelle ungefähr aus:
A               B
PLZ          Umsatz
26340+    3455
26000     3461
XXX         3405
263166   3405
26384     3466
26a86     3465
26388    145

Ich hoffe ihr könnt mir helfen, ich habe schon so gut wie alles Mögliche ausprobiert :20:

[Fennek]

Hallo,


die zweite Frage zuerst:

das Aufsummieren mehrerer Umsätze derselben PLZ geht am einfachsten mit einer Pivot-Tabelle.

Für das Umgruppieren der ungültigen PLZ müssten mathematische Regeln definiert werden.

mfg

[dennis1793]

Hallo,


die zweite Frage zuerst:

das Aufsummieren mehrerer Umsätze derselben PLZ geht am einfachsten mit einer Pivot-Tabelle.

Für das Umgruppieren der ungültigen PLZ müssten mathematische Regeln definiert werden.

mfg

Vielen Dank schonmal für die Hilfe! Ich kenne mich damit leider überhaput nicht aus und wie müsste ein Pivot-Tabelle aussehen? :20:

[atilla]

Hallo,

hier dürfte VBA Einsatz vonnöten sein.

Wie definierst Du falsche PLZ.
Hast Du eine Liste mit gütigen PLZ, mit der man die PLZ in Deiner Liste vergleichen kann.

Über die Verteilung und wie es genau ablaufen soll, solltest Du Dich auch etwas ausführlicher auslassen.

[dennis1793]

Hallo,

hier dürfte VBA Einsatz vonnöten sein.

Wie definierst Du falsche PLZ.
Hast Du eine Liste mit gütigen PLZ, mit der man die PLZ in Deiner Liste vergleichen kann.

Über die Verteilung und wie es genau ablaufen soll, solltest Du Dich auch etwas ausführlicher auslassen.

Hallo atilla,
vielen Dank für Deine Antwort :)

Mit einer falschen PLZ meine ich z.B. 6-stellige oder wenn Buchstaben oder sogar ganz aus Wörtern bestehen.

Aufteilung:
Kommt die PLZ in meiner Liste des öfter als einmal vor, soll EXCEL diese in einer Zeile zusammenführen, insbesondere die Spalte mit den Umsätzen.
Bei undefinierbaren PLZ, also PLZ die es nicht gibt oder die fehlerhaft sind, sollen auf alle anderen richtigen PLZ verteilt werden.
 
Vielen Dank für deine Hilfe :35: :35:

[snb]

Bitte nicht zitieren (quoten).

Ich fürchte das es eine lange Thread werden wird.

[atilla]

Hallo,

dann stell bitte eine Beispielmappe ein an der man sich austoben kann.

Und eine Frage noch: Es kann nicht sein, dass z.B 1,23 € auf 2543 PLZ verteilt werden muss? Was ich damit sagen will, nach der Verteilung können die Summen nicht mehr die gleichen sein, wie zu Beginn.

[dennis1793]

Das ist richtig, die Summen sollen komplett verteilt werden, wenn diese nicht den PLZ zugeordnet werden können.

Ich habe ein Tabellenblatt mit den gesamten Postleitzahlen aus Deutschland für die Überprüfung beigefügt.

[atilla]

Hallo,

unten stehenden Code in ein allgemeines Modul eingeben und starten:

Code:

Option Explicit

Sub aufsummieren_und_verteilen()
Dim lngZSumme As Long, lngZPlz As Long
Dim strgBereich As String
Dim dblS As Double
Dim dKey As String
Dim D As Object
Dim i As Long
Set D = CreateObject("Scripting.Dictionary")

With Sheets("PLZ DE komplett")
 lngZPlz = .Cells(Rows.Count, 1).End(xlUp).Row
 strgBereich = "'PLZ DE komplett'!" & .Range("A2:A" & lngZPlz).Address
End With

With Sheets("Tabelle1")
   lngZSumme = .Cells(Rows.Count, 1).End(xlUp).Row
   .Range("D3:D" & lngZSumme).FormulaLocal = "=Zählenwenn(" & strgBereich & ";A3)"

 For i = 3 To lngZSumme
   If .Cells(i, 4) > 0 Then
     dKey = .Cells(i, 1)
     D(dKey) = D(dKey) + .Cells(i, 2)
   Else
     dblS = dblS + .Cells(i, 2)
   End If
 Next i
 .Range("D3:D" & lngZSumme).ClearContents
End With

With Sheets("Tabelle überarbeitet")
 .Cells.ClearContents
 .Range("A1:C1") = Array("PLZ", "Summe Umsatz", "Kummilierte Summe")  'Hier in der Zeile fehlte ganz am Anfang der Zeile ein Punkt (nachgetragen 17:34)
 .Range("A2:A" & D.Count + 1) = Application.Transpose(D.keys)
 .Range("B2:B" & D.Count + 1) = Application.Transpose(D.items)
 For i = 1 To D.Count
   .Cells(i + 1, 3).Value = .Cells(i + 1, 2).Value + Application.WorksheetFunction.Round(dblS / D.Count, 2)
 Next i
End With

End Sub

Die Verteilung der Umsätze wird auf zwei Stellen gerundet berechnet.

[atilla]

Hallo noch einmal,

oder ohne die Schleife am Ende so:

Code:

Option Explicit

Sub aufsummieren_und_verteilen()
Dim lngZSumme As Long, lngZPlz As Long
Dim strgBereich As String
Dim dblS As Double
Dim dKey As String
Dim D As Object
Dim i As Long
Set D = CreateObject("Scripting.Dictionary")

With Sheets("PLZ DE komplett")
 lngZPlz = .Cells(Rows.Count, 1).End(xlUp).Row
 strgBereich = "'PLZ DE komplett'!" & .Range("A2:A" & lngZPlz).Address
End With

With Sheets("Tabelle1")
   lngZSumme = .Cells(Rows.Count, 1).End(xlUp).Row
   .Range("D3:D" & lngZSumme).FormulaLocal = "=Zählenwenn(" & strgBereich & ";A3)"

 For i = 3 To lngZSumme
   If .Cells(i, 4) > 0 Then
     dKey = .Cells(i, 1)
     D(dKey) = D(dKey) + .Cells(i, 2)
   Else
     dblS = dblS + .Cells(i, 2)
   End If
 Next i
 .Range("D3:D" & lngZSumme).ClearContents
End With

With Sheets("Tabelle überarbeitet")
 .Cells.ClearContents
 .Range("A1:C1") = Array("PLZ", "Summe Umsatz", "Kummilierte Summe")
 .Range("A2:A" & D.Count + 1) = Application.Transpose(D.keys)
 .Range("B2:B" & D.Count + 1) = Application.Transpose(D.items)
 .Range("C2:C" & D.Count + 1).FormulaLocal = "=B2+Runden(" & dblS / D.Count & ";2)"
 .Range("C2:C" & D.Count + 1).Value = .Range("C2:C" & D.Count + 1).Value
End With

End Sub