Zusätzlicher Minimum Wert angeben
16.11.2015 16:54:00
Manuel
wie schaffe ich es in dem folgenden Code von einem anderem Forumsmitglied einen weiteren Minimum Wert anzugeben?
Mein Plan war es den jeweiligen MiniumWert aus iTemp 5 anzuzeigen für das jeweilige Jahr. Hier zunächst mal der Ausgangscode:
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
Dim dMin1 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
Call Zellen_farbig_formartieren_vorher
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
If Sheets("Home").Cells(50, 50).Value = "deutsch" Then
vKopftext = Array("", "", "", "", "Artikel", "Jahr", "Anzahl", "Summe", "Min.", "Max.", " _
Durchschnitt")
Else
vKopftext = Array("", "", "", "", "Articel", "Year", "Number", "Total", "Min.", "Max.", " _
Average")
End If
' 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("Upload") ' es betrifft das Eingabe-Tabellenblatt
vTemp = .Range("C2:O" & .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))
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("Daten_Informationen") ' es betrifft das Ausgabe-Tabellenblatt
' die letzte belegte Zeile ermitteln
.Unprotect
On Error Resume Next
lLetzte = .Range("D:J").Find("*", , xlFormulas, xlWhole, xlByRows, xlPrevious).Row
If lLetzte dMax Then dMax = CDbl(vTemp(iTemp, 13))
hier habe ich versucht die untenstehende Codezeile einzufügen
End If
Next iTemp
.Range("H" & lZeile).Value = dMin ' den Min-Wert ausgeben
.Range("K" & lZeile).Value = dMin1 ' den Min-Wert ausgeben
.Range("I" & lZeile).Value = dMax ' den Max-Wert ausgeben
' den Durchschnitts-Wert errechnen
If .Range("F" & lZeile).Value 0 Then _
.Range("J" & lZeile).Value = .Range("G" & lZeile).Value / .Range("F" & lZeile). _
Value
' Artiukel und Jahreszahl in getrennte Spalten ausgeben
.Range("D" & lZeile).Value = vSplit(0)
.Range("E" & lZeile).Value = vSplit(1)
Next lZeile
' die Zeile für die Gesamt-Summe aufbauen
If Sheets("Home").Cells(50, 50).Value = "deutsch" Then
.Range("F" & lLetzte + 2).Value = "Gesamt"
Else
.Range("F" & lLetzte + 2).Value = "Total"
End If
.Range("G" & lLetzte + 2).Value = WorksheetFunction.Sum(.Range("G4:G" & lLetzte))
GoSub Zwischensummen ' die Subroutine zur Bildung von Zwischensummen aufrufen
On Error Resume Next
lLetzte = .Range("D:J").Find("*", , xlFormulas, xlWhole, xlByRows, xlPrevious).Row
If lLetzte
Kopfzeile: ' hier eird die Kopfzeile erzeugt
With ThisWorkbook.Worksheets("Daten_Informationen")
' die Überschrift aus dem Kopfzeiolen-Text Array erzeugen
For iKopfText = 1 To UBound(vKopftext)
.Cells(2, iKopfText).Value = vKopftext(iKopfText)
Next iKopfText
' die Kopf-Spalten werden hier eingefärbt und fett angezeigt
.Range("D2:J2").Interior.Color = RGB(251, 229, 15)
.Range("D2:J2").Font.Bold = True
' die Spalten B-G zentriert formatieren
With .Columns("E:J")
.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("Daten_Informationen") ' es betrifft das Ausgabe- _
Tabellenblatt
lLetzte = .Cells(.Rows.Count, 4).End(xlUp).Row ' die letzte belgte Zeile in Spalte 1 = A _
feststellen
If lLetzte 0 Then _
.Range("J" & lZeile + 1).Value = dZwiSum / iZwiAnz
.Range("D" & lZeile + 1 & ":J" & lZeile + 1).Font.Bold = True
' den neuen Gruppenbegriff, sowie die erste neue Anzahl und die erste neue Summe _
speichern
sArtikel = .Range("D" & lZeile).Value
dZwiSum = Val(Replace(.Range("G" & lZeile).Value, ",", "."))
iZwiAnz = Val(.Range("F" & 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, 13)) dMax Then dMax = CDbl(vTemp(iTemp, 13))
End If
Next iTemp
Return ' der Rücksprung aus dem GoSub
End Sub
Ich habe jetzt versucht den Min. Wert für das jeweilige Jahr mit der Codezeile zu berechnen:If CDbl(vTemp(iTemp, 5)) > dMin1 Then dMin1 = CDbl(vTemp(iTemp, 5))
Ich weis das ">" falsch gesetzt ist und eigentlich dieses Zeichen " Kann mir vielleicht jemand behilflich sein und mir sagen was ich genau einfügen muss, damit ich den iTemp 5 Wert für das entsprechende Jahr und Artikel angezeigt bekomme?
Liebe Grüße,
Manuel