Microsoft Excel

Herbers Excel/VBA-Archiv

Summenprodukt 3 Beding. mit Scripting Dictionary


Betrifft: Summenprodukt 3 Beding. mit Scripting Dictionary
von: Wolfgang
Geschrieben am: 15.12.2018 22:08:56

Hallo,
ich habe mit Hilfe des Forums das Scripting Dictionary erfolgreich in meinen Code einbauen können. Es sucht mir zu einer Anzahl von Spalteneinträgen in Sheet1 Summenwerte basierend auf 2 Bedingungen (Monat und Rahmenvertrags Nr.)aus einer anderen Tabelle in Sheet2.

'----------------------------------------------------------------------
Dim WS1 As Worksheet, WS2 As Worksheet
Dim objWerte(1 To 12) As Object, oObj
Dim lngI As Long, intMonate As Integer
Dim arrWS2, arrOut(), iCounter As Integer
Dim intMonat As Integer, dblWert As Double, vntRV

Set WS1 = Worksheets("PO-Dashboard")
Set WS2 = Worksheets("PO-Data-Source")
For intMonate = 1 To 12
Set objWerte(intMonate) = CreateObject("scripting.dictionary")
Next intMonate

'RV-Nummern aus Dashboard sammeln
With WS1
For lngI = 2 To .Cells(Rows.Count, 2).End(xlUp).Row
For intMonate = 1 To 12
objWerte(intMonate)(.Cells(lngI, 2).Value) = 0
Next intMonate
Next lngI
End With

'Daten aus WS2 in Array
arrWS2 = WS2.Cells(1, 1).CurrentRegion.Resize(, 24)

'Werte sammeln
For lngI = 3 To UBound(arrWS2) ' von Zeile 3 bis letzte Zeile arrWS2
vntRV = arrWS2(lngI, 7) ' vntRV ist in Zeile lngI von Spalte 7
If objWerte(1).exists(vntRV) Then ' nur RV aus Dashboard
If IsNumeric(arrWS2(lngI, 24)) Then ' in X steht eine Zahl
dblWert = CDbl(arrWS2(lngI, 24)) ' converts value to double
intMonat = (Month(CDate(arrWS2(lngI, 2)))) ' liefert den Monatswert (1-12) vom Datum
objWerte(intMonat)(vntRV) = objWerte(intMonat)(vntRV) + dblWert
End If
End If
Next lngI

'AusgabeArray
ReDim arrOut(1 To objWerte(1).Count, 1 To 13)
For Each oObj In objWerte(1)
iCounter = iCounter + 1
arrOut(iCounter, 1) = oObj
For intMonate = 1 To 12
arrOut(iCounter, intMonate + 1) = objWerte(intMonate)(oObj)
Next intMonate
Next oObj

'Array in Tabelle schreiben
WS1.Cells(2, 2).Resize(UBound(arrOut), UBound(arrOut, 2)) = arrOut
WS1.Activate

WS1.Columns("A:N").AutoFit
WS1.Columns("C:N").NumberFormat = "#,##0_ ;[Red]-#,##0 "

'----------------------------------------------------------------------

Frage:
Wie kann ich jetzt diesen Code um ein weiteres Kriterium / Bedingungen erweitern?
Sprich: Summiere Werte in Spalte 25 wenn Rahmenvertrag = x und RV-Position = 10 und Monat = Januar?

Vielen Dank für Eure Hilfe!

  

Betrifft: AW: Summenprodukt 3 Beding. mit Scripting Dictionary
von: Matthias
Geschrieben am: 16.12.2018 18:57:01

Moin!
Also an Hand des Codes und ohne Datei ist das nicht ganz so einfach. Also ich würde im if then Zweig dann die weitere Prüfung einbauen. Wenn dann beide passen, den weiteren Code (also Summe Spalte 25) vornehmen. Könnte so aussehen:

'Werte sammeln
For lngI = 3 To UBound(arrWS2) ' von Zeile 3 bis letzte Zeile arrWS2
    vntRV = arrWS2(lngI, 7) ' vntRV ist in Zeile lngI von Spalte 7
    If objWerte(1).exists(vntRV) Then ' nur RV aus Dashboard
        If IsNumeric(arrWS2(lngI, 24)) Then ' in X steht eine Zahl
            if prüfung auf jahr
                dblWert = CDbl(arrWS2(lngI, 24)) ' converts value to double
                intMonat = (Month(CDate(arrWS2(lngI, 2)))) ' liefert den Monatswert (1-12) vom  _
Datum
                objWerte(intMonat)(vntRV) = objWerte(intMonat)(vntRV) + dblWert
            End If
        End If
    End If
Next lngI

VG