AW: VBA J-bilanz aus mehreren Sheets
19.12.2014 21:02:47
Daniel
Hi
als Formel würde ich hier SummeWenns verwenden, das ist etwas schneller als Summenprodukt:
=SUMMEWENNS(INDIREKT("'"&$A6&"'!W:W");INDIREKT("'"&$A6&"'!V:V");">="&DATUM(B$2;1;1); INDIREKT("'"&$A6&"'!V:V");"
einen eleganten Makrocode gibts natürlich auch, hier für den Fall geschrieben, dass die Blattnamen und Jahreszahlen in Zeile 2 und Spalte A schon von dir von Hand befüllt sind und die Werte dann nur zugeordnet werden:
Sub Auswertung()
Dim sh As Worksheet
Dim dicBlatt As Object
Dim dicSumme As Object
Dim arr
Dim z As Long
Dim Jahr
Dim arrBlatt
Dim arrJahr
Dim arrErg
Set dicBlatt = CreateObject("Scripting.dictionary")
With ThisWorkbook.Sheets("Auswertung")
'--- Summen lesen
For Each sh In ThisWorkbook.Worksheets
If sh.Name .Name Then
Set dicSumme = CreateObject("Scripting.dictionary")
arr = sh.UsedRange.Columns(22).Resize(, 2).Value
For z = 2 To UBound(arr, 1)
If arr(z, 1) > 0 Then dicSumme(Year(arr(z, 1))) = dicSumme(Year(arr(z, 1))) + _
arr(z, 2)
Next
Set dicBlatt(sh.Name) = dicSumme
End If
Next
'--- Ergebnis schreiben
arrBlatt = Range(.Cells(6, 1), .Cells(.Rows.Count, 1).End(xlUp)).Value
arrJahr = Range(.Cells(2, 2), .Cells(2, .Columns.Count).End(xlToLeft)).Value
ReDim arrErg(1 To UBound(arrBlatt, 1), 1 To UBound(arrJahr, 2))
For z = 1 To UBound(arrBlatt, 1)
If dicSumme.exists(arrBlatt(z, 1)) Then
Set dicSumme = dicBlatt(arrBlatt(z, 1))
For Jahr = 1 To UBound(arrJahr, 2)
arrErg(z, Jahr) = dicSumme(arrJahr(1, Jahr))
Next
End If
Next
.Cells(6, 2).Resize(UBound(arrErg, 1), UBound(arrErg, 2)) = arrErg
End With
End Sub
ist die Frage, ob das wirklich besser ist, als ein Code, der "nur" die Formel in die Zellen schreibt und dann ggf die Formel durch die Werte ersetzt:
Sub Auswertung2()
Dim Zelle1 As Range
Dim Zelle2 As Range
With Sheets("Auswertung")
Set Zelle1 = .Cells(.Rows.Count, 1).End(xlUp)
Set Zelle2 = .Cells(2, .Columns.Count).End(xlToLeft)
With .Range(.Cells(6, 2), Intersect(Zelle1.EntireRow, Zelle2.EntireColumn))
.FormulaR1C1 = "=SUMIFS(INDIRECT(""'""&RC1&""'!W:W""),INDIRECT(""'""&RC1&""'!V:V"")" & _
","">=""&DATE(R2C,1,1),INDIRECT(""'""&RC1&""'!V:V""),""
Gruß Daniel