Min/Max

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("Tabelle1") ' es betrifft das Eingabe-Tabellenblatt
vTemp = .Range("A2:R" & .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, 6)) & "##" & Trim$(vTemp(iTemp, 1)) & "##" & 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  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("B" & lZeile).Value = vSplit(1)
.Range("I" & lZeile).Value = vSplit(2)
'.Range("H" & lZeile).Value = vSplit(3)
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