Postleitzahlen zusammenfügen und ungültige herausfiltern

[RPP63]

Moin!
Und täglich grüßt das Murmeltier. ;)
Bringe EINMAL Ordnung in Dein Chaos und sorge zukünftig (also ab sofort) dafür, dass Falscheingaben nicht mehr möglich sind!
Nimm dazu Kontakt mit der Firma der Registrierkasse auf.
Und nein, Du wirst den Code wohl (noch) nicht anpassen können, zumal als Laie.

Gruß Ralf

[atilla]

Hallo,

dann so:

Code:

Sub aufsummieren_und_verteilen()
 Dim i As Long, j As Long
 Dim lngSpalte As Long, lngZZ As Long
 Dim lngZSumme As Long, lngZPlz As Long
 Dim strgBereich As String, strgZählen As String, strgSummen
 Dim feldSummen
 Dim feldUmsatz

 Sheets("2. ---> Daten entnehmen").Cells.Clear
 
 Application.ScreenUpdating = False
 
 With Sheets("PLZ nicht verändern")
  lngZPlz = .Cells(Rows.Count, 1).End(xlUp).Row
  strgBereich = "'PLZ nicht verändern'!" & .Range("A2:A" & lngZPlz).Address
 End With
 
 With Sheets("1. ---> Daten einfügen")
   lngZSumme = .Cells(Rows.Count, 1).End(xlUp).Row
   lngSpalte = .Cells(5, .Columns.Count).End(xlToLeft).Column + 1
   strgZählen = .Range(.Cells(6, lngSpalte), .Cells(lngZSumme, lngSpalte)).Address
   strgSummen = .Range(.Cells(lngZSumme + 1, 2), .Cells(lngZSumme + 1, lngSpalte - 1)).Address
   .Range(strgZählen).FormulaLocal = "=Zählenwenn(" & strgBereich & ";A6)"
   .Range(strgZählen).Value = .Range(strgZählen).Value
   .Range(strgSummen).FormulaLocal = "=SUMMEWENN(" & strgZählen & ";0;B6:B2628)"
   feldSummen = .Range(strgSummen)
    .Range(strgSummen).Clear
   
   If .AutoFilterMode = True Then
     If .FilterMode = True Then .ShowAllData
       .Range(.Cells(1, 1), .Cells(lngZSumme + 1, lngSpalte)).AutoFilter Field:=lngSpalte, Criteria1:=">0", _
       Operator:=xlAnd
   Else
       .Range(.Cells(1, 1), .Cells(lngZSumme + 1, lngSpalte)).AutoFilter Field:=lngSpalte, Criteria1:=">0", _
       Operator:=xlAnd
   End If
 
   Sheets("2. ---> Daten entnehmen").Cells.Clear
   .AutoFilter.Range.Offset(1, 0).Resize(, .AutoFilter.Range.Columns.Count - 1).Copy Sheets("2. ---> Daten entnehmen").Range("A3")
   .AutoFilterMode = False
  .Range(strgZählen).Clear
 End With
 
 With Sheets("2. ---> Daten entnehmen")
   lngZZ = .Cells(.Rows.Count, 1).End(xlUp).Row
   feldUmsatz = .Range(.Cells(3, 2), .Cells(lngZZ, lngSpalte - 1))
   
   For j = 1 To lngSpalte - 2
     For i = 1 To lngZZ - 2
       feldUmsatz(i, j) = Application.WorksheetFunction.Round(feldUmsatz(i, j) + feldSummen(1, j) / (lngZZ - 4), 2)
     Next i
   Next j
   .Range(.Cells(3, 2), .Cells(lngZZ, lngSpalte - 1)) = feldUmsatz
   Überschriften
   .Rows.Hidden = False
 End With

 Application.ScreenUpdating = True
End Sub

Sub Überschriften()
 With Sheets("2. ---> Daten entnehmen")
  .Range("A1:V1") = Array("PLZ", "BV Gesamt 2014", "KV Gesamt 2014", "Gesamt 2014", "BV 01 Schlafen 2014", "KV 01 Schlafen 2014", "Gesamt 01 Schlafen 2014", "BV 02 Anbauwände 2014", "KV 02 Anbauwände 2014", "Gesamt 02 Anbauwände 2014", "BV 03 Küchen & Bäder 2014", "KV 03 Küchen & Bäder 2014", "Gesamt 03 Küchen & Bäder 2014", "BV 04 Polstermöbel 2014", "KV 04 Polstermöbel 2014", "Gesamt 04 Polstermöbel 2014", "BV 05 Kleinmöbel 2014", "KV 05 Kleinmöbel 2014", "Gesamt 05 Kleinmöbel 2014", "BV 06 Speisezimmer 2014", "KV 06 Speisezimmer 2014", "Gesamt 06 Speisezimmer 2014")
  .Range("W1:AQ1") = Array("BV 08 Mitnahme 2014", "KV 08 Mitnahme 2014", "Gesamt 08 Mitnahme 2014", "BV 09 KiBa 2014", "KV 09 KiBa 2014", "Gesamt 09 KiBa 2014", "BV 80 Leuchten 2014", "KV 80 Leuchten 2014", "Gesamt 80 Leuchten 2014", "BV 92 Bilder 2014", "KV 92 Bilder 2014", "Gesamt 92 Bilder 2014", "BV 93-97 Heimtex 2014", "KV 93-97 Heimtex 2014", "Gesamt 93-97 Heimtex 2014", "BV Boutique 2014", "KV Boutique 2014", "Gesamt Boutique 2014", "BV Orient 2014", "KV Orient 2014", "Gesamt Orient 2014")
  .Range("AR1:BL1") = Array("BV Gesamt 2015", "KV Gesamt 2015", "Gesamt 2015", "BV 01 Schlafen 2015", "KV 01 Schlafen 2015", "Gesamt 01 Schlafen 2015", "BV 02 Anbauwände 2015", "KV 02 Anbauwände 2015", "Gesamt 02 Anbauwände 2015", "BV 03 Küchen & Bäder 2015", "KV 03 Küchen & Bäder 2015", "Gesamt 03 Küchen & Bäder 2015", "BV 04 Polstermöbel 2015", "KV 04 Polstermöbel 2015", "Gesamt 04 Polstermöbel 2015", "BV 05 Kleinmöbel 2015", "KV 05 Kleinmöbel 2015", "Gesamt 05 Kleinmöbel 2015", "BV 06 Speisezimmer 2015", "KV 06 Speisezimmer 2015", "Gesamt 06 Speisezimmer 2015")
  .Range("BM1:CG1") = Array("BV 08 Mitnahme 2015", "KV 08 Mitnahme 2015", "Gesamt 08 Mitnahme 2015", "BV 09 KiBa 2015", "KV 09 KiBa 2015", "Gesamt 09 KiBa 2015", "BV 80 Leuchten 2015", "KV 80 Leuchten 2015", "Gesamt 80 Leuchten 2015", "BV 92 Bilder 2015", "KV 92 Bilder 2015", "Gesamt 92 Bilder 2015", "BV 93-97 Heimtex 2015", "KV 93-97 Heimtex 2015", "Gesamt 93-97 Heimtex 2015", "BV Boutique 2015", "KV Boutique 2015", "Gesamt Boutique 2015", "BV Orient 2015", "KV Orient 2015", "Gesamt Orient 2015")
  .Range("CH1:DA1") = Array("BV Gesamt 2016", "KV Gesamt 2016", "Gesamt 2016", "BV 01 Schlafen 2016", "KV 01 Schlafen 2016", "Gesamt 01 Schlafen 2016", "KV 02 Anbauwände 2016", "Gesamt 02 Anbauwände 2016", "BV 03 Küchen & Bäder 2016", "KV 03 Küchen & Bäder 2016", "Gesamt 03 Küchen & Bäder 2016", "BV 04 Polstermöbel 2016", "KV 04 Polstermöbel 2016", "Gesamt 04 Polstermöbel 2016", "BV 05 Kleinmöbel 2016", "KV 05 Kleinmöbel 2016", "Gesamt 05 Kleinmöbel 2016", "BV 06 Speisezimmer 2016", "KV 06 Speisezimmer 2016", "Gesamt 06 Speisezimmer 2016")
  .Range("DB1:DV1") = Array("BV 08 Mitnahme 2016", "KV 08 Mitnahme 2016", "Gesamt 08 Mitnahme 2016", "BV 09 KiBa 2016", "KV 09 KiBa 2016", "Gesamt 09 KiBa 2016", "BV 80 Leuchten 2016", "KV 80 Leuchten 2016", "Gesamt 80 Leuchten 2016", "BV 92 Bilder 2016", "KV 92 Bilder 2016", "Gesamt 92 Bilder 2016", "BV 93-97 Heimtex 2016", "KV 93-97 Heimtex 2016", "Gesamt 93-97 Heimtex 2016", "BV Boutique 2016", "KV Boutique 2016", "Gesamt Boutique 2016", "BV Orient 2016", "KV Orient 2016", "Gesamt Orient 2016")
  .Range("DW1:EP1") = Array("BV Gesamt 2017", "KV Gesamt 2017", "Gesamt 2017", "BV 01 Schlafen 2017", "KV 01 Schlafen 2017", "Gesamt 01 Schlafen 2017", "KV 02 Anbauwände 2017", "Gesamt 02 Anbauwände 2017", "BV 03 Küchen & Bäder 2017", "KV 03 Küchen & Bäder 2017", "Gesamt 03 Küchen & Bäder 2017", "BV 04 Polstermöbel 2017", "KV 04 Polstermöbel 2017", "Gesamt 04 Polstermöbel 2017", "BV 05 Kleinmöbel 2017", "KV 05 Kleinmöbel 2017", "Gesamt 05 Kleinmöbel 2017", "BV 06 Speisezimmer 2017", "KV 06 Speisezimmer 2017", "Gesamt 06 Speisezimmer 2017")
  .Range("EQ1:FK1") = Array("BV 08 Mitnahme 2017", "KV 08 Mitnahme 2017", "Gesamt 08 Mitnahme 2017", "BV 09 KiBa 2017", "KV 09 KiBa 2017", "Gesamt 09 KiBa 2017", "BV 80 Leuchten 2017", "KV 80 Leuchten 2017", "Gesamt 80 Leuchten 2017", "BV 92 Bilder 2017", "KV 92 Bilder 2017", "Gesamt 92 Bilder 2017", "BV 93-97 Heimtex 2017", "KV 93-97 Heimtex 2017", "Gesamt 93-97 Heimtex 2017", "BV Boutique 2017", "KV Boutique 2017", "Gesamt Boutique 2017", "BV Orient 2017", "KV Orient 2017", "Gesamt Orient 2017")
   .Rows(2) = Sheets("1. ---> Daten einfügen").Rows(5).Value
 End With
End Sub

[dennis1793]

Guten Morgen Ralf,

das habe ich mir schon fast gedacht, dass der Code nicht verändert oder von mir erstellt werden kann

Wenn der Code einmal passt erleichtert er mir sehr viel Arbeit, da ich wöchentlich die neuen Umsatzzahlen pflege. Ansonsten bin ich immer stunden damit beschäftigt die PLZ richtig zuzuweisen. Dass es so kompliziert mit diesem Code ist, hätte ich nicht gedacht, da es komplettes Neuland für mich ist.

Ab sofort, lassen wir keine falschen PLZ an der Kasse mehr zu. Es liegt daran, dass dieses noch nie ausgewertet wurde.
 
Gruß Dennis

[dennis1793]

COOL!!!! :15:
 
Herzlichen Dank atilla!!! :100:

Ich bin mega happy!

Wie würde die Datei aussehen, wenn man das Jahr 2018 mit einbauen würde, kann man dann einen Code von z.B. 2017 kopierten und dann die Spalten und Zeilen ändern?
 
Du hast mir sehr geholfen! Wie lange hast du eigentlich dafür gebraucht den Code zu schreiben? Der hat es ja richtig in sich

[atilla]

Hallo,

theoretisch ist der Code flexibel.
das heißt, Du könntest die Werte für 2018 an die letzte Spalte anfügen.
Der Code müsste das verarbeiten, auch wenn Zeilen hinzukommen.

Nur die Überschriften müsstest Du anpassen.