Das Clever-Excel-Forum.de - Treffen
findet vom 15. - 17. September 2017 in Thüringen / Region Großer Inselsberg statt. Hotelbuchung ab sofort möglich.


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
to top
#2
Tja, ohne Datei geht eben nichts... , sorryConfused


Angehängte Dateien
.xlsx   CUBA 2014.xlsx (Größe: 57,44 KB / Downloads: 7)
to 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 7 / Office 2007
to 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
to 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

Excel 2007
to 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 7 / Office 2007
to 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
to top


Möglicherweise verwandte Themen...
Thema Verfasser Antworten Ansichten Letzter Beitrag
  [schwierige Aufgabe] Zelleninhalt nur teilweise vergleichen Serpent Driver 55 1.969 02.08.2016, 21:53
Letzter Beitrag: Ego
  mit Sverweis zu lösen ? waga 5 423 28.11.2015, 12:59
Letzter Beitrag: waga
  VBA-Aufgabe (Schaltfläche) cuba 4 494 01.10.2015, 15:03
Letzter Beitrag: snb
  Excel Neuling - Aufgabe: Verketten von Zellen bei variabler Ausgangslage ? Bnic3 2 605 19.09.2015, 16:32
Letzter Beitrag: Bnic3
  Herkules Aufgabe für einen Anfänger BITTE HELFEN Andi_FFM 8 1.340 17.09.2015, 09:22
Letzter Beitrag: Andi_FFM
  Excel Aufgabe Quadrat 10 984 16.09.2015, 19:59
Letzter Beitrag: steve1da
  Excel Aufgabe, komme nicht weiter gasmax 6 1.251 21.08.2015, 09:37
Letzter Beitrag: Excelfreak1711
  Aufgabe: Sortiment eines Supermarktes Felipo95 25 3.257 06.07.2015, 20:51
Letzter Beitrag: Felipo95
  Profi Aufgabe - Mittels VBA Google Suchergebnisse abspeichern Kathrin Doppelbauer 3 1.119 14.06.2015, 18:22
Letzter Beitrag: Kathrin Doppelbauer
  Geburtstags-Aufgabe (wo ist mein Fehler?) Felipo95 13 1.772 11.05.2015, 09:06
Letzter Beitrag: WillWissen

Gehe zu:


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