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!