Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Probleme mit Pivottabelle
#11
Hoppla, jetzt hat es funktioniert. Muss mir mal ansehen, was ich da alles verkehrt gemacht habe.

Vielen Dank an Euch beide!

LG
cuba
Antworten Top
#12
Hallo Cuba,

wenn ich das richtig beobachtet habe, scheinen ein paar Daten zu fehlen.
Ich schau mir das nachher noch einmal an, was ich da vermurkst habe.
Gruß Atilla
Antworten Top
#13
Hallo Cuba,

so, hab jetzt festgestellt, dass drei Zeilen untergeschlagen wurden. Mein Fehler.

Ersetz bitte den gesamten Code mit diesem:

Code:
Sub zusammenfassen()
   Dim i As Long
   Dim lngLetzte As Long
   Dim vntA
   Dim feld
   Dim objDic1
   Set objDic1 = CreateObject("Scripting.Dictionary")
  
   'Überschriften
   vntA = Array("Order", "KND-Nr.", "Kunde", "Umsatz")
  
   Application.ScreenUpdating = False                   'Bildschirmaktualisierung aus
  
   With Worksheets("Tabelle1")
      .Columns("AC:AF").ClearContents                    'Inhalte der Spalten "AC:AF" löschen
      .Range("AC3:AF3") = vntA                           'Überschriften in den Bereich "AC3:AF3" eintragen
      lngLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row   'letzte belegte Zeile in Spalte A
      feld = .Range("A4:E" & lngLetzte)                  'Bereich AC3 bis AF bis zur letzten belgeten in ein Variant Array schreiben
      For i = LBound(feld) To UBound(feld)               'Alle Array Zeilen durchlaufen
         If feld(i, 1) <> 0 Then                         'wenn Zelle in Spalte nicht 0 dann einlesen
            objDic1(feld(i, 1)) = objDic1(feld(i, 1)) + feld(i, 4)   'Unicate in Dictionary einlesen und die Spalte D aufaddieren
         End If
      Next i
      
      'Daten in die entsprechenden Spalten schreiben
      .Range("AD4:AD" & objDic1.Count + 3) = WorksheetFunction.Transpose(objDic1.keys) 'Unicate in Spalte AD
      .Range("AC4:AC" & objDic1.Count + 3) = WorksheetFunction.Transpose(objDic1.items) 'Summen von "St" in Spalte AC
      .Range("AE4:AE" & objDic1.Count + 3).FormulaLocal = "=SVERWEIS(AD4;$A$4:$B$" & lngLetzte & ";2;0)" 'In Spalte AE SVERWEIS() Formel zur Ermittlung der Kundennamen
      .Range("AF4:AF" & objDic1.Count + 3).FormulaLocal = "=SUMMEWENN($A$4:$A$" & lngLetzte & ";AD4;$E$4:$E$" & lngLetzte & ")" ''In Spalte AE SUMMEWENN()() Formel zur Ermittlung der Kundennamen
      .Range("AE4:AE" & objDic1.Count + 3).Value = .Range("AE4:AE" & objDic1.Count + 3).Value 'Formeln mit ihren Werten überschreiben
      .Range("AF4:AF" & objDic1.Count + 3).Value = .Range("AF4:AF" & objDic1.Count + 3).Value ''Formeln mit ihren Werten überschreiben
      
      'Nach Spalte AC absteigend sortieren
       .Range("AC3:AF" & objDic1.Count + 3).Sort Key1:=.Range("AC4"), Order1:=xlDescending, Key2:=.Range("AF4"), Order2:=xlDescending, Header:=xlYes, _
           OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
           DataOption1:=xlSortNormal
  
   End With
  
   Application.ScreenUpdating = True   'Bildschirmaktualisierung ein

End Sub
Gruß Atilla
[-] Folgende(r) 1 Nutzer sagt Danke an atilla für diesen Beitrag:
  • cuba
Antworten Top
#14
Hallo Attila

Nein, tut mir leid, ich habe den Eintrag tatsächlich nicht gesehen, sorry.

Konnte es jetzt nachbessern

herzlichen Dank und schöne Festtage

cbua
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste