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.

VBA-Aufgabe zu lösen
#1
Hallo Clever-Excel-Forum

Ich hatte diese Aufgabe schon einmal im Forum, die dann auch auf geniale Art und Weise beantwortet wurde. Nach etlichen Einträgen sehe ich jedoch, dass da drei Eintragungen einfach nicht involviert sind, finde den Fehler nicht und verzweifle beinahe daran, weil ich den Ursprung selber nicht finden kann.

Ich habe Euch die Datei beigefügt. Die drei Eintragungen befinden sich in den Zeilen 549, 550 und 556, welche ich rot markiert habe.

Mittels dem Aktualiserungs-Button sollten diese drei Aufträge ebenfalls in die Liste integriert werden, was eben nicht passiert.

Ich würde mich riesig darüber freuen, wenn mir jemand den Fehler aufzeigen kann, damit ich die Originaldatei, welche dann auch die Kundennamne beinhaltet, korrekt korrigieren darf.

Vielen Dank im Voraus
cuba
Antworten Top
#2
Tja, ohne Datei geht eben nichts... , sorry:s


Angehängte Dateien
.xlsx   CUBA 2014.xlsx (Größe: 57,44 KB / Downloads: 7)
Antworten Top
#3
Hallo,

Du beziehst dich auf ein Makro aber in der Datei ist kein Makro enthalten. Könntest Du das posten?
Gruß Stefan
Win 10 / Office 2016
Antworten Top
#4
Hallo

Sorry, das war jtut nicht beansichtigt......

Hier der Code.


Sub Schaltfläche2_Klicken()
Call zusammenfassen
End Sub

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("AB2014")
.Columns("g:j").ClearContents 'Inhalte der Spalten "AC:AF" löschen
.Range("g3:j3") = 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 Saplten schreiben
.Range("h4:h" & objDic1.Count) = WorksheetFunction.Transpose(objDic1.keys) 'Unicate in Spalte h
.Range("g4:g" & objDic1.Count) = WorksheetFunction.Transpose(objDic1.items) 'Summen von "St" in Spalte AC
.Range("i4:i" & objDic1.Count).FormulaLocal = "=SVERWEIS(h4;$a$4:$B$" & lngLetzte & ";2;0)" 'In Spalte AE SVERWEIS() Formel zur Ermittlung der Kundennamen
.Range("j4:j" & objDic1.Count).FormulaLocal = "=SUMMEWENN($A$4:$A$" & lngLetzte & ";h4;$E$4:$E$" & lngLetzte & ")" ''In Spalte AE SUMMEWENN()() Formel zur Ermittlung der Kundennamen
.Range("i4:i" & objDic1.Count).Value = .Range("i4:i" & objDic1.Count).Value 'Formeln mit ihren Werten überschreiben
.Range("j4:j" & objDic1.Count).Value = .Range("j4:j" & objDic1.Count).Value ''Formeln mit ihren Werten überschreiben

'erst nach Spalte AC dann nach Spalte AF absteigend sortieren
.Range("g3:j" & objDic1.Count).Sort Key1:=.Range("g4"), Order1:=xlDescending, Key2:=.Range("j4"), Order2:=xlDescending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

End With

Application.ScreenUpdating = True 'Bildschirmaktualisierung ein

End Sub
Antworten Top
#5
Hallo,

Das hatte ich im alten Beitrag aber schon festgestellt und dort gelöst.
Du hast offensichtlich dort meinen letzen Beitrag nicht gelesen.

Dort hatte ich das geschrieben:

Zitat:[/quote]
"so, hab jetzt festgestellt, dass drei Zeilen untergeschlagen wurden. Mein Fehler."
Gruß Atilla
Antworten Top
#6
Hallo,

wie Atilla bereits festgestellt hat, hast Du das Makro nicht richtig angepaßt. Das habe ich jetzt versucht und poste es mal.

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("AB2014")
      .Columns("g:j").ClearContents 'Inhalte der Spalten "AC:AF" löschen
      .Range("g3:j3") = 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 Saplten schreiben
      .Range("h4:h" & objDic1.Count + 3) = WorksheetFunction.Transpose(objDic1.keys) 'Unicate in Spalte h
      .Range("g4:g" & objDic1.Count + 3) = WorksheetFunction.Transpose(objDic1.items) 'Summen von "St" in Spalte AC
      .Range("i4:i" & objDic1.Count + 3).FormulaLocal = "=SVERWEIS(h4;$a$4:$B$" & lngLetzte & ";2;0)" 'In Spalte AE SVERWEIS() Formel zur Ermittlung der Kundennamen
      .Range("j4:j" & objDic1.Count + 3).FormulaLocal = "=SUMMEWENN($A$4:$A$" & lngLetzte & ";h4;$E$4:$E$" & lngLetzte & ")" ''In Spalte AE SUMMEWENN()() Formel zur Ermittlung der Kundennamen
      .Range("i4:i" & objDic1.Count + 3).Value = .Range("i4:i" & objDic1.Count + 3).Value 'Formeln mit ihren Werten überschreiben
      .Range("j4:j" & objDic1.Count + 3).Value = .Range("j4:j" & objDic1.Count + 3).Value ''Formeln mit ihren Werten überschreiben
      
      'erst nach Spalte AC dann nach Spalte AF absteigend sortieren
      .Range("g3:j" & objDic1.Count + 3).Sort Key1:=.Range("g4"), Order1:=xlDescending, Key2:=.Range("j4"), Order2:=xlDescending, Header:=xlYes, _
      OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
      DataOption1:=xlSortNormal
  
   End With
  
   Application.ScreenUpdating = True 'Bildschirmaktualisierung ein

End Sub
Gruß Stefan
Win 10 / Office 2016
Antworten Top
#7
Hallo Attila

Vielen Dank für Deine Hilfe!

Habe den Fehler korrigieren können. Hatte Deinen Beitrag dazu in der Tat nicht gelesen.....

Gruss
cuba
Antworten Top


Gehe zu:


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