Hallo zusammen,
ich habe folgenden Teil-Code, der super funktioniert.
Eine Tabelle wird zusammengefasst, in dem die letzten beiden Spalten näher betrachtet werden. Jede Zeile in der Spalte "Text" (letzte Spalte) wird durchsucht und bei einem doppeltem Eintrag wird die Zahl in der gleichen Zeile aus der Spalte "Wert" (vorletzte Spalte) aufaddiert und so einzelne Zeilen mit gleichem Text zusammengefasst.
Nun kommt aber noch eine Bedingung hinzu: Bevor die Zeilen mit doppeltem Eintrag in "Text" zusammengefasst werden (also Werte addieren), muss das Datum näher betrachtet werden. Es soll jeweils alles monatlich zusammengefasst werden. D.h. "Text" gleich und Monat aus Spalte "Datum" gleich. Da die Tabelle jährlich erneuert wird, muss man das Jahr nicht beachten.
Ist es möglich die SUMIF-Funktion mit mehreren Bedingungen zu knüpfen? Und wie füge ich am Besten die Hilfsspalte für die Spalte "Datum" hinzu?
Ich habe eine Beispieldatei mit Makro hochgeladen :)
https://www.herber.de/bbs/user/98356.xlsm
Vielen Dank ^^
Yade
Sub summary()
Dim rng As Range, rngC As Range
Dim lngCol As Long, Spa_1 As Long, Spa_2 As Long
On Error Resume Next
Application.ScreenUpdating = False
With ActiveSheet
Set rng = .ListObjects(1).Range
If rng Is Nothing Then Exit Sub
.Copy after:=ActiveSheet
End With
With ActiveSheet
.Name = rng.Parent.Name & " Summary"
If .AutoFilterMode Then .ShowAllData
Spa_1 = rng.Column + rng.Columns.Count
Spa_2 = Spa_1 + 1
.Range(.Cells(1, Spa_1), .Cells(1, Spa_2)) = "XXX"
.Range(.Cells(2, Spa_1), .Cells(rng.Rows.Count - 1, Spa_1)).FormulaR1C1 = _
"=IF(OR(RC[-1]="""",COUNTIF(R2C[-1]:RC[-1],RC[-1])=1),""x"","""")"
.Range(.Cells(2, Spa_2), .Cells(rng.Rows.Count - 1, Spa_2)).FormulaR1C1 = _
"=SUMIF(C[-2]:C[-2],RC[-2],C[-3]:C[-3])"
Set rngC = .Columns(Spa_1).SpecialCells(xlCellTypeFormulas)
rngC = rngC.Value
Set rngC = .Columns(Spa_2).SpecialCells(xlCellTypeFormulas)
rngC = rngC.Value
For Each rngC In .Range(.Cells(2, Spa_1), .Cells(rng.Rows.Count - 1, Spa_1)) _
.SpecialCells(xlCellTypeConstants)
rngC.Offset(0, -2) = rngC.Offset(0, 1).Value
Next
.Cells(1, Spa_1).CurrentRegion.Sort .Cells(1, Spa_1), xlAscending, Header:=xlYes
Set rngC = .Range(.Cells(2, Spa_1), .Cells(rng.Rows.Count - 1, Spa_1)) _
.SpecialCells(xlCellTypeBlanks)
If Not rngC Is Nothing Then rngC.EntireRow.Delete
.Columns(Spa_2).Delete
.Columns(Spa_1).Delete
End With
Application.ScreenUpdating = True
Set rng = Nothing
Set rngC = Nothing
End Sub