Min/Max

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Min/Max
von: Manuel
Geschrieben am: 05.11.2015 20:39:40

Hallo liebe Forumsmitglieder,
ich bin gerade wieder an meiner Min/Max/Durchschnittfunktion am basteln. Mit dem folgenden Code, den ich angepasst habe wollte ich das erreichen.
Das Problem ist aber, dass ich für Min und Max jeweils immer -99999 und 99999 angezeigt bekomme, obwohl die „If“ Gleichung erfüllt ist. Entferne ich den If Absatz wird Min und Max errechnet. Jedoch mit dem Problem, dass dabei die Min und Max Werte von allen Zeilen der Ursprungsdatei berechnet werden und nicht (so wie ich es wollte) nur von dem jeweiligen Teil was in Spalte A später steht (im iTemp ist es Spalte 6).
Kann mir dabei einer helfen?


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 < 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)
      
'        die Daten nach Artikel + Jahr (incl. ## dazwischen) sortieren
      lLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
      If lLetzte < 11 Then lLetzte = 11
      .Range("A11:I" & lLetzte).Sort _
          Key1:=.Range("A11"), _
          Order1:=xlAscending, _
          Header:=xlNo, _
          OrderCustom:=1, _
          MatchCase:=False, _
          Orientation:=xlTopToBottom
   
'        den Min- Max- und Durchschitts-Wert ermitteln
      For lZeile = 11 To lLetzte
         dMin = 99999.99  ' ein hoher Min-Wert
         dMax = -99999.99 ' ein kleiner Max-Wert
         For iTemp = 1 To UBound(vTemp) ' den gesamten temporären Array abarbeiten
'              Artikel und Jahr an Trenner '##' splitten
            vSplit = Split(.Range("A" & lZeile).Value, "##")
'              handelt es sich um den Artikel und die Jahreszahl?
            If vSplit(0) = vTemp(iTemp, 6) And vSplit(1) = vTemp(iTemp, 1) And Val(vSplit(2)) =  _
 _
Year(vTemp(iTemp, 3)) Then
'                 den Min- und den Max-Wert ermitteln
               If CDbl(vTemp(iTemp, 14)) < dMin Then dMin = CDbl(vTemp(iTemp, 14))
               If CDbl(vTemp(iTemp, 14)) > 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 < 11 Then lLetzte = 11  ' ist die letzte Spalte < 4, dann wird sie auf 4  _
gesetzt
      On Error GoTo 0
      
'         die Spalten formatieren und einen Rahmen zeichnen
      .Range("C" & lLetzte & ":D" & lLetzte).Font.Bold = True
      .Range("C11:D" & lLetzte - 2).NumberFormat = "#,##0"
      .Range("D11:D" & lLetzte).NumberFormat = "#,##0.00"
      .Range("E11:G" & lLetzte - 2).NumberFormat = "#,##0.00"
      With Range("A2:G" & lLetzte)
         .Borders.LineStyle = xlContinuous
         .Borders.Weight = xlThin
         .Borders.ColorIndex = xlAutomatic
      End With
   End With
   
   Application.ScreenUpdating = True ' das Bildschirm-Update wieder zulassen
   
   Set Dic_Zaehlen = Nothing ' die Ressourcen wieder freigeben
   Set Dic_Summe = Nothing
   
   Exit Sub ' das Makro HIER - VOR der/den Subroutinen verlassen!
'
'<><><><><><><><><><><><><><><<><><><><><><><><><><><><><><><><><><><<><><><><><><><><><><><><>< _
 _
>
'
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 < 11 Then lLetzte = 11              ' ist die letzte Spalte < 4, dann wird sie  _
 _
auf 4 gesetzt
'       den ersten Gruppenbegriff in einer Variablen speichern, und die ersten Beträge  _
ebenfalls
      sArtikel = Trim$(.Range("A" & lLetzte).Value)
      dZwiSum = Val(Replace(.Range("D" & lLetzte).Value, ",", "."))
      iZwiAnz = Val(.Range("C" & lLetzte).Value)
      
'        die inzwischen ausgegebenen Werte von unten her (letzte Zeile) nach oben abarbeiten
      For lZeile = lLetzte - 1 To 3 Step -1
         If sArtikel = Trim$(.Range("A" & lZeile).Value) Then ' ist es noch der gleiche Artikel? _
 _
            dZwiSum = dZwiSum + Val(Replace(.Range("D" & lZeile).Value, ",", ".")) ' dann  _
werden die
            iZwiAnz = iZwiAnz + Val(.Range("C" & lZeile).Value)                    ' Werte  _
addiert
          Else                                                ' sonst, bei Gruppenwechsel ( _
neuer Artikel)
            .Rows(lZeile + 1).Insert Shift:=xlDown            ' ein Zeile einfügen
            .Range("A" & lZeile + 1).Value = sArtikel         ' den Gruppenbegriff (den Artikel) _
 _
 übertragen
            .Range("B" & lZeile + 1).Value = "Gesamt"          ' den Texr "Summe" ausgeben
            .Range("C" & lZeile + 1).Value = iZwiAnz          ' die addierte Anzahl je Artikel   _
_
ausgeben
            .Range("D" & lZeile + 1).Value = dZwiSum          ' die addierte Summe  je Artikel   _
_
ausgeben
            GoSub Artikel_Min_Max                             ' das Min, Max je Artikel  _
ermitteln
            .Range("E" & lZeile + 1).Value = dMin
            .Range("F" & lZeile + 1).Value = dMax
            If iZwiAnz <> 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)) < dMin Then dMin = CDbl(vTemp(iTemp, 14))
         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

Danke,
Manuel

Bild

Betrifft: AW: Min/Max
von: fcs
Geschrieben am: 06.11.2015 03:09:45
Hallo Manuel,
in der Zeile

      sText = Trim$(vTemp(iTemp, 6)) & "##" & Trim$(vTemp(iTemp, 1)) & "##" _
         & Year(vTemp(iTemp,3)) '& "##" & Month(vTemp(iTemp, 3))

werden führende/nachgestellte Leerzeichen in Spalten 6 und 1 ggf. entfernt.
In dem Code-Teil wo das Minimum/Maximum berechnet wird,
      For lZeile = 11 To lLetzte
         dMin = 99999.99  ' ein hoher Min-Wert
         dMax = -99999.99 ' ein kleiner Max-Wert
         For iTemp = 1 To UBound(vTemp) ' den gesamten temporären Array abarbeiten
'              Artikel und Jahr an Trenner '##' splitten
            vSplit = Split(.Range("A" & lZeile).Value, "##")
'              handelt es sich um den Artikel und die Jahreszahl?
            If vSplit(0) = vTemp(iTemp, 6) And vSplit(1) = vTemp(iTemp, 1) _
                And Val(vSplit(2)) =Year(vTemp(iTemp, 3)) Then
'                 den Min- und den Max-Wert ermitteln
               If CDbl(vTemp(iTemp, 14)) < dMin Then dMin = CDbl(vTemp(iTemp, 14))
               If CDbl(vTemp(iTemp, 14)) > dMax Then dMax = CDbl(vTemp(iTemp, 14))
            End If
         Next iTemp

können jetzt 2 Tatsachen Probleme bereiten:
(1)
Die Werte vSplit(0) und vSplit(1) werden mit den Werten ohne Trim verglichen. Sollten in den Spalten 6 und 1 des Arrays führende/nachgestellte Leerzeichen vorhanden sein, dann liefert die Prüfung immmer False und die Vorgabe-Werte werden als Ergebnis ausgegeben.
(2)
Die Werte vSplit(0) und vSplit(1) sind immer vom Typ String (Text). Sind die Werte in den Spalten 6 oder 1 des Arrays vTemp nummerisch, dann liefert die If-Prüfung ebenfalls immer False.
Du musst die Vergleiche in
            If vSplit(0) = vTemp(iTemp, 6) And vSplit(1) = vTemp(iTemp, 1) _
                And Val(vSplit(2)) =Year(vTemp(iTemp, 3)) Then

so anpassen, dass immer gleichartige Datentypen verglichen werden (Zahlen oder Texte).
z.B.:
            If vSplit(0) = Trim(vTemp(itemp, 6)) And vSplit(1) = Trim(vTemp(itemp, 1)) _
                And Val(vSplit(2)) = Year(vTemp(itemp, 3)) Then
Gruß
Franz

Bild

Betrifft: AW: Min/Max
von: Manuel
Geschrieben am: 06.11.2015 14:17:27
Perfekt Franz, hab vielen Dank!
Kannst du mir noch erklären wie es möglich ist nicht nur eine Summe aufzuzählen, was ich ja mit dieser Zeile mache:
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.
Sondern direkt mehrere?
Ich habe das Ganze versucht mit:
Dic_Summe1(sText) = Dic_Summe1(sText) + vTemp(iTemp, 13)
Ich weiß das ich zweimal die selben Spalten aus dem Array aufsummiere, das habe ich aber gemacht um zu überprüfen ob die Ergebnisse gleich sind. Leider ist das nicht der Fall.
Was kann ich machen eine weitere Summe zu erhalten und mit der Zeile wieder auszugeben:
.Range("J11").Resize(Dic_Zaehlen.Count) = WorksheetFunction.Transpose(Dic_Summe1.items)
Liebe Grüße und vielen Dank,
Manuel

Bild

Betrifft: AW: Summenberechnung - Dictionary-Scripting-Objekt
von: fcs
Geschrieben am: 08.11.2015 20:20:59
Hallo Manuel,
ich kenne mich mit den Feinheiten des Dictionary-Scripting-Objekts nicht aus.
Da müsste jemand andes weiter helfen.
Gruß
Franz

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Namensliste ergänzen"