AW: Daten aus Liste laden
02.11.2015 19:46:44
Manuel
Hey liebe Forumsmitglieder,
ich habe das ganze jetzt versucht aus einem anderen Code, den mit Peter erstellt hatte (Danke nochmal an dieser Stelle), zu übernehmen und ein wenig umzuschreiben.
Leider ist es mir nur gelungen die Jahre zu integrieren. Könnt ihr euch den Code vielleicht mal ansehen und mir erklären wo der Fehler liegt?
Option Explicit
Public a
Public Sub JJJ() ' 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 ' 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") ' das Dictionary zuordnen
' die Texte der Spalten-Überschriften - der erste Text mit Index 0 ist nur Dummy
vKopftext = Array(" ", "Artikel", "", "Anzahl", "Summe", "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)) & "##" & Year(vTemp(iTemp, 3)) & "##" & Month(vTemp(iTemp, _
4))
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.
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 dMax Then dMax = CDbl(vTemp(iTemp, 14))
End If
Next iTemp
.Range("E" & lZeile).Value = dMin ' den Min-Wert ausgeben
.Range("F" & lZeile).Value = dMax ' den Max-Wert ausgeben
' den Durchschnitts-Wert errechnen
If .Range("C" & lZeile).Value 0 Then _
.Range("G" & lZeile).Value = .Range("D" & lZeile).Value / .Range("C" & lZeile). _
Value
' Artiukel und Jahreszahl in getrennte Spalten ausgeben
.Range("A" & lZeile).Value = vSplit(0)
.Range("I" & lZeile).Value = vSplit(1)
.Range("H" & lZeile).Value = vSplit(2)
Next lZeile
' die Zeile für die Gesamt-Summe aufbauen
.Range("C" & lLetzte + 2).Value = "Gesamt"
.Range("D" & lLetzte + 2).Value = WorksheetFunction.Sum(.Range("D11:D" & lLetzte))
.Range("E" & lLetzte + 2).Value = WorksheetFunction.Sum(.Range("E11:E" & lLetzte)) / ( _
lLetzte - 10)
.Range("F" & lLetzte + 2).Value = WorksheetFunction.Sum(.Range("F11:F" & lLetzte)) / ( _
lLetzte - 10)
.Range("G" & lLetzte + 2).Value = WorksheetFunction.Sum(.Range("G11:G" & lLetzte)) / ( _
lLetzte - 10)
'a = (lLetzte - 10)
'MsgBox a
GoSub Zwischensummen ' die Subroutine zur Bildung von Zwischensummen aufrufen
On Error Resume Next
lLetzte = .Range("A:G").Find("*", , xlFormulas, xlWhole, xlByRows, xlPrevious).Row
If lLetzte
Kopfzeile: ' hier eird die Kopfzeile erzeugt
With ThisWorkbook.Worksheets("Tabelle3")
' die Überschrift aus dem Kopfzeiolen-Text Array erzeugen
For iKopfText = 1 To UBound(vKopftext)
.Cells(1, iKopfText).Value = vKopftext(iKopfText)
Next iKopfText
' die Kopf-Spalten werden hier eingefärbt und fett angezeigt
.Range("A1:I1").Interior.Color = RGB(204, 255, 204)
.Range("A1:I1").Font.Bold = True
' die Spalten B-G zentriert formatieren
With .Columns("B:I")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
End With
End With
Return ' der Rücksprung aus dem GoSub
Zwischensummen: ' hier werden die Zwischensummen je Artikel erzeugt und ausgegeben
With ThisWorkbook.Worksheets("Tabelle3") ' es betrifft das Ausgabe-Tabellenblatt
lLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row ' die letzte belgte Zeile in Spalte 1 = A _
feststellen
If lLetzte 0 Then _
.Range("G" & lZeile + 1).Value = dZwiSum / iZwiAnz
.Range("A" & lZeile + 1 & ":G" & lZeile + 1).Font.Bold = True
' den neuen Gruppenbegriff, sowie die erste neue Anzahl und die erste neue Summe _
speichern
sArtikel = .Range("A" & lZeile).Value
dZwiSum = Val(Replace(.Range("D" & lZeile).Value, ",", "."))
iZwiAnz = Val(.Range("C" & lZeile).Value)
End If
Next lZeile ' die nächste Zeile nach oben abarbeiten
End With
Return ' der Rücksprung aus dem GoSub
Artikel_Min_Max: ' hier wird das Min, Max für den Artukel (ohne das Jahr) ermittelt
dMin = 99999.99
dMax = -99999.99
For iTemp = 1 To UBound(vTemp)
If sArtikel = Trim$(vTemp(iTemp, 1)) Then
If CDbl(vTemp(iTemp, 14)) dMax Then dMax = CDbl(vTemp(iTemp, 14))
End If
Next iTemp
Return ' der Rücksprung aus dem GoSub
End Sub
Grüße,
Manuel