Minium, Maximum und Mittelwert mit VBA

Manuel · 2015-10-26T16:02:52+00:00

Hallo liebes Forum, ich hab ein kleiens Problem, bei dem ich leider komplett überfordert bin und hoffe das ihr mir weiterhelfen könntet. Ich habe in einem Excel Sheet(Upload) eine lange Liste an unterschiedlichen Teilen, die nach dem Upload nicht sortiert sind, jetzt würde ich gerne von allen gleichen Teilen (eindeutige Bezeichnung in Spalte C) das Minimum, Maximum und den Mittelwert (notwendigen Zahlen in Spalte O) auf ein anderes Sheet (Informationen) eingetragen bekommen mit dem entsprechenden Teil in Spalte A, Minimum in Spalte B usw.. Könnt ihr mir vielleicht helfen, ich weiß leider überhaupt keinen Rat. Liebe Grüße und besten Dank Manuel

Hallo Peter!
Danke für deine Lösung. Klappt super, eine nachfrage habe ich allerdings. Ich habe die Zeile"Gesamt" noch nicht. Dafür habe ich jetzt mal deinen Makro genommen den du zuvor hochgeladen hattest und rufe ihn mit Call Artikel... auf. Jedoch schreibt er mir meinen "Gesamt" Eintrag von jedem Teil immer in die erste Zeile und nicht vor jedes Teil.
Dein Makro was ich etwas angepasst habe ist dieser:

Public Sub Nach_Artikel_addieren_I()
Dim Dic_Zaehlen  As Object
Dim Dic_Summe    As Object
Dim vTemp        As Variant
Dim iTemp        As Integer
Dim lZeile       As Long
Dim dMin         As Double
Dim dMax         As Double
Dim lLetzte      As Long
Application.ScreenUpdating = False
Set Dic_Zaehlen = CreateObject("Scripting.Dictionary")
Set Dic_Summe = CreateObject("Scripting.Dictionary")
With ThisWorkbook.Worksheets("Upload")
vTemp = .Range("C2:O" & .Cells(.Rows.Count, 3).End(xlUp).Row)
End With
For iTemp = 1 To UBound(vTemp)
Dic_Zaehlen(vTemp(iTemp, 1)) = Dic_Zaehlen(vTemp(iTemp, 1)) + 1             ' das Item um  _
1 hochzählen
Dic_Summe(vTemp(iTemp, 1)) = Dic_Summe(vTemp(iTemp, 1)) + vTemp(iTemp, 13) ' den Wert in  _
O zu dem Item dazuaddieren.
Next iTemp
'     Ausgabe in die Spalten A:M
With ThisWorkbook.Worksheets("Informationen")
lLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
If lLetzte  dMax Then dMax = vTemp(iTemp, 13)
End If
Next iTemp
.Range("D" & lZeile).Value = dMin
.Range("E" & lZeile).Value = dMax
If .Range("C" & lZeile).Value  0 Then _
.Range("F" & lZeile).Value = .Range("D" & lZeile).Value / .Range("C" & lZeile). _
Value
Next lZeile
End With
Application.ScreenUpdating = True
End Sub

Kannst du mir dabei nochmal helfen?
Liebe Grüße,
Manuel

Hallo Manuel,
erwartest du die Summe so, wie es dieses Makro - übrigens jetzt mit Dokumentation - ausgibt?
Gruß Peter

Public Sub Nach_Artikel_addieren() ' 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
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
'     zur schnelleren Bearbeitung (besseren Performance) die Eingaben in ein Array speichern
With ThisWorkbook.Worksheets("Upload")
vTemp = .Range("C2:O" & .Cells(.Rows.Count, 3).End(xlUp).Row)
End With
'     die Eingabe-Werte an die Dictionary übergeben
For iTemp = 1 To UBound(vTemp)
'        den Key aus Artikelnummer und Jahr zusammensetzen
sText = Trim$(vTemp(iTemp, 1)) & "##" & Year(vTemp(iTemp, 3))
Dic_Zaehlen(sText) = Dic_Zaehlen(sText) + 1             ' das Item um 1 hochzählen
Dic_Summe(sText) = Dic_Summe(sText) + vTemp(iTemp, 13)  ' den Wert in O zu dem Item  _
dazuaddieren.
Next iTemp
'     Ausgabe in die Spalten A:G
With ThisWorkbook.Worksheets("Informationen")
lLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row ' die letzte belgte Zeile in Spalte 1 = A  _
feststellen
If lLetzte  dMax Then dMax = vTemp(iTemp, 13)
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)
Next lZeile
'         die Zeile für die Gesamt-Summe aufbauen
.Range("C" & lLetzte + 2).Value = "Gesamt"
.Range("D" & lLetzte + 2).Value = WorksheetFunction.Sum(.Range("D4:D" & lLetzte))
End With
Application.ScreenUpdating = True ' das Bildschirm-Update wieder zulassen
Set Dic_Zaehlen = Nothing ' die Ressourcen wieder freigeben
Set Dic_Summe = Nothing
End Sub

Minium, Maximum und Mittelwert mit VBA

Forumthread: Minium, Maximum und Mittelwert mit VBA

26
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Minium, Maximum und Mittelwert mit VBA

Forumthread: Minium, Maximum und Mittelwert mit VBA

26 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

26
Beiträge zum Forumthread

Beiträge zu diesem Forumthread