Hallo alle zusammen,
ich habe eine Frage zu einem Code den ich geringfügig abgewandelt habe. Hier erstmal der wichtige Ausschnitt vom Code:
Public Sub Laden_Auswertung() ' dieses Makro berücksichtigt die Jahreszahl aus dem Datum in Spalte E
Dim Dic_Zaehlen As Object ' das Dictionary Objekt zum Zählen der Vorkommen
Dim Dic_Summe As Object
Dim Dic_Summe1 As Object
Dim Dic_Summe2 As Object
Dim Dic_Summe3 As Object ' das Dictionary Objekt zur Addition der Werte
Dim vTemp As Variant ' ein tempoträrer Array zur schnelleren Bearbeitung
Dim iTemp As Integer ' der For/Next Schleifen Index zum temporären Array
Dim sText As String ' der zusammengesetzte Key zur Speicherung im Dictionary
Dim lLetzte As Long ' dei letzte belegte Zeile im Ergebnis-Blatt
Dim vSplit As Variant ' ein Bereich zum erneuten Aufteilen der Key-Werte
Dim lZeile As Long ' For/Next Schleifen-Index -hier die Zeile
Dim dMin As Double ' der Minimal-Wert
Dim dMax As Double ' der Maximal-Wert
Dim vKopftext As Variant ' die Überschrift zu den Spalten als Array
Dim iKopfText As Integer ' der Index zum Kopfzeilen-Array
Dim sArtikel As String ' der Gruppenbegriff zur Zwischensummen Bildung
Dim dZwiSum As Double ' die Addition zur jeweiligen Zwischensumme
Dim iZwiAnz As Integer ' die Addition der Anzahl Vorkommen des Artikels
Application.ScreenUpdating = False ' kein Bildschirm-Update während des Makro-Laufs
Set Dic_Zaehlen = CreateObject("Scripting.Dictionary") ' das Dictionary zuordnen
Set Dic_Summe = CreateObject("Scripting.Dictionary")
Set Dic_Summe1 = CreateObject("Scripting.Dictionary") ' das Dictionary zuordnen
Set Dic_Summe2 = CreateObject("Scripting.Dictionary")
Set Dic_Summe3 = CreateObject("Scripting.Dictionary")
' die Texte der Spalten-Überschriften - der erste Text mit Index 0 ist nur Dummy
vKopftext = Array(" ", "Artikel", "", "Anzahl", "Verbrauch", "Min", "Max", "Durchschnitt", "Monat", "Jahr")
' zur schnelleren Bearbeitung (besseren Performance) die Eingaben in ein Array speichern
' es werden nur die relevanten Spalten C-O gespeichert, wobei dann die Spalte C aus dem
' Tabellenblatt die Spalte 1 in Array, E die Spalte 3 und O die Spalte 13 wird.
' die Zeilen im Array beginnen bei 1 zu zählen.
With ThisWorkbook.Worksheets("Inventory") ' es betrifft das Eingabe-Tabellenblatt
vTemp = .Range("C2:P" & .Cells(.Rows.Count, 3).End(xlUp).Row)
End With
' die Eingabe-Werte an die beiden Dictionary übergeben
For iTemp = 1 To UBound(vTemp)
' den Key aus Artikelnummer und Jahr zusammensetzen, Trennzeichen ist ##
sText = Trim$(vTemp(iTemp, 1)) & "##" & Trim$(vTemp(iTemp, 2)) & "##" & Year(vTemp(iTemp, 3)) & "##" & Month(vTemp(iTemp, 3))
Dic_Zaehlen(sText) = Dic_Zaehlen(sText) + 1 ' das Item um 1 hochzählen
Dic_Summe(sText) = Dic_Summe(sText) + vTemp(iTemp, 14) ' den Wert in O zu dem Item dazuaddieren.
Dic_Summe1(sText) = Dic_Summe1(sText) + vTemp(iTemp, 14)
Next iTemp
' Ausgabe in die Spalten A:G
With ThisWorkbook.Worksheets("Tabelle3") ' es betrifft das Ausgabe-Tabellenblatt
' die letzte belegte Zeile ermitteln
.Unprotect
On Error Resume Next
lLetzte = .Range("A:G").Find("*", , xlFormulas, xlWhole, xlByRows, xlPrevious).Row
If lLetzte < 11 Then lLetzte = 11 ' ist die letzte Spalte < 4, dann wird sie auf 4 gesetzt
On Error GoTo 0
' die vorhandenen Werte komplett löschen, auch die Farben
.Range("A2:M" & lLetzte).Clear
.Range("A2:M2").Interior.Color = xlNone
GoSub Kopfzeile ' die Überschrift ausgeben
' die gesammelten Wert aus den Dictionaries ausgeben
.Range("A11").Resize(Dic_Zaehlen.Count) = WorksheetFunction.Transpose(Dic_Zaehlen.Keys) ' die Artikel
.Range("C11").Resize(Dic_Zaehlen.Count) = WorksheetFunction.Transpose(Dic_Zaehlen.Items) ' die Anzahl
.Range("D11").Resize(Dic_Zaehlen.Count) = WorksheetFunction.Transpose(Dic_Summe.Items) ' die Summe
.Range("J11").Resize(Dic_Zaehlen.Count) = WorksheetFunction.Transpose(Dic_Summe1.Items)
Wie kann es sein das ich mit diesen Zeilen unterschiedliche Zahlen erhalte?
Dic_Summe(sText) = Dic_Summe(sText) + vTemp(iTemp, 14) ' den Wert in O zu dem Item dazuaddieren.
Dic_Summe1(sText) = Dic_Summe1(sText) + vTemp(iTemp, 14)
.Range("D11").Resize(Dic_Zaehlen.Count) = WorksheetFunction.Transpose(Dic_Summe.Items) ' die Summe
.Range("J11").Resize(Dic_Zaehlen.Count) = WorksheetFunction.Transpose(Dic_Summe1.Items)
Kann mir da einer behilflich sein?
Liebe Grüße