AW: Summen automatisch bilden !!!
01.04.2009 22:17:15
fcs
Hallo Zoran,
die Aufbereitung der Formeln per Maro ist ziemlich aufwendig zu programmieren, da die Pivot-Tabelle sozusagen rückwärts in ihrer Struktur analysiert werden muss.
Hier mein Ergebnis. Als Funktion wird hierbei die Funktion TEILERGEBNIS für die Summierung verwendet, da hier bei den Zusammenfassenden Summen die Zellen mit Teilergebnis-Formeln nicht berücksichtigt werden.
Gruß
Franz
Sub Summenformeln()
Dim wks As Worksheet
Dim Zeile As Long
Dim ZelleGesamt As Range, ZelleMA_ergebnis As Range, ZelleKndErgebnis As Range
Dim ZeileGesamtE&, ZeileGesamtA&, ZeileMA_E&, ZeileMA_A&, ZeileKnd_E&, ZeileKnd_A&
Set wks = Worksheets("Pivot")
Const SpaMa& = 2 'Spalte ADM7-name
Const SpaKnd& = 3 'Spalte Hpt.Knd.-Name
Const SpaL3& = 4 'Spalte PhierL2-Name
Const SpaFormel = 6 'Süalte für Summenformeln
Const ColorindexSum& = 36 'Farbe für summenzelle - hellgelb
Const ColorIndexEintrag& = 35 'farbe für Einagebzellen - hellgrün
ZeileGesamtA = 6 '1. Datenzeile in Pivottabelle
With wks
Zeile = .Cells(.Rows.Count, SpaMa).End(xlUp).Row
With .Range(.Cells(ZeileGesamtA, SpaFormel), .Cells(Zeile, SpaFormel))
.Interior.ColorIndex = ColorIndexEintrag
.Font.Bold = False
End With
'Formel für Gesamtergebnis
With .Cells(Zeile, SpaFormel)
.Formula = "=SUBTOTAL(9,R[-" & Zeile - ZeileGesamtA & "]C:R[-1]C)"
.Interior.ColorIndex = ColorindexSum
.Font.Bold = True
End With
For Zeile = Zeile - 1 To ZeileGesamtA Step -1
If InStr(1, .Cells(Zeile, SpaMa), "Ergebnis") > 0 Then
If ZelleMA_ergebnis Is Nothing Then
Set ZelleMA_ergebnis = .Cells(Zeile, SpaFormel)
ZeileMA_E = Zeile - 1
Else
ZeileMA_A = Zeile + 1
ZeileKnd_A = Zeile + 1
With ZelleMA_ergebnis
.Formula = "=SUBTOTAL(9,R[-" & ZeileMA_E - ZeileMA_A + 1 & "]C:R[-1]C)"
.Interior.ColorIndex = ColorindexSum
.Font.Bold = True
End With
With ZelleKndErgebnis
.Formula = "=SUBTOTAL(9,R[-" & ZeileKnd_E - ZeileKnd_A + 1 & "]C:R[-1]C)"
.Interior.ColorIndex = ColorindexSum
.Font.Bold = True
End With
Set ZelleMA_ergebnis = .Cells(Zeile, SpaFormel)
ZeileMA_E = Zeile - 1
ZeileKnd_E = Zeile - 1
Set ZelleKndErgebnis = Nothing
End If
ElseIf InStr(1, .Cells(Zeile, SpaKnd), "Ergebnis") > 0 Then
If ZelleKndErgebnis Is Nothing Then
Set ZelleKndErgebnis = .Cells(Zeile, SpaFormel)
ZeileKnd_E = Zeile - 1
Else
ZeileKnd_A = Zeile + 1
With ZelleKndErgebnis
.Formula = "=SUBTOTAL(9,R[-" & ZeileKnd_E - ZeileKnd_A + 1 & "]C:R[-1]C)"
.Interior.ColorIndex = ColorindexSum
.Font.Bold = True
End With
Set ZelleKndErgebnis = .Cells(Zeile, SpaFormel)
ZeileKnd_E = Zeile - 1
End If
End If
Next
ZeileKnd_A = Zeile + 1
ZeileMA_A = Zeile + 1
With ZelleKndErgebnis
.Formula = "=SUBTOTAL(9,R[-" & ZeileKnd_E - ZeileKnd_A + 1 & "]C:R[-1]C)"
.Interior.ColorIndex = ColorindexSum
.Font.Bold = True
End With
With ZelleMA_ergebnis
.Formula = "=SUBTOTAL(9,R[-" & ZeileMA_E - ZeileMA_A + 1 & "]C:R[-1]C)"
.Interior.ColorIndex = ColorindexSum
.Font.Bold = True
End With
End With
End Sub