AW: Ausgangsblätter variieren
13.02.2023 20:23:59
Yal
Letzte Version:
Sub Formel_einfügen()
Dim KopfZeile As Long
Dim LetzteZeile As Long
Dim AnzEint As Long 'Anzahl Eintragspalten
Dim ESma As Long 'erste Splate Marktanteil
Dim ESue As Long 'erste Spalte Umsatzentwicklung
Dim WertSpalte As Long
Dim z As Long, s As Long 'Zeile und Spalte
Dim Eb1_Sum As Double
Dim Eb2_Sum As Double
Const ES1 = 5 'imer Spalte E
With ActiveWorkbook.Worksheets(1) 'wir nehmen an, es handelt sich immer um das erste Blatt in der gerade aktiven Arbeitsmappe
'Suche erste/letzte Zeile
LetzteZeile = .Cells(Rows.Count, "A").End(xlUp).Row
KopfZeile = .Cells(LetzteZeile, "A").End(xlUp).Row - 1
'Suche Eintragbereich
AnzEint = 1 - ES1 + .Cells(KopfZeile, ES1).End(xlToRight).Column
ESma = ES1 + AnzEint + 1
ESue = ES1 + AnzEint * 2 + 2
'Spalten einfügen
.Cells(1, ESma).Resize(1, AnzEint + 1).EntireColumn.Insert Shift:=xlToRight
.Cells(1, ESue).Resize(1, AnzEint).EntireColumn.Insert Shift:=xlToRight
'Überschrift einfügen
.Rows(KopfZeile).HorizontalAlignment = xlCenter 'Reset
With .Cells(KopfZeile, ESma)
.Value = "Marktanteil"
.Resize(1, AnzEint).HorizontalAlignment = xlCenterAcrossSelection
End With
With .Cells(KopfZeile, ESue)
.Value = "Umsatzentwicklung"
.Resize(1, AnzEint - 1).HorizontalAlignment = xlCenterAcrossSelection
End With
'Formel einfügen 'Markanteil
For s = ESma To ESma + AnzEint - 1
WertSpalte = s - ESma + ES1
For z = KopfZeile + 1 To LetzteZeile
'hier muss geprüft werden, ob eine Summe erster Ebene und/oder zweiter Ebene vorliegt
If .Cells(z, 2) = "" Then
Eb1_Sum = .Cells(z, WertSpalte).Value
.Cells(z, s) = 1
.Cells(z, s).NumberFormat = "0.0%___ ;-0.0%___ ;-"
ElseIf .Cells(z, WertSpalte).Value > "" Then
If .Cells(z, 3) = "" Then
Eb2_Sum = .Cells(z, WertSpalte).Value
.Cells(z, s).Value = CDbl(.Cells(z, WertSpalte)) / Eb1_Sum
.Cells(z, s).NumberFormat = "0.0%__ ;-0.0%__ ;-"
Else
If .Cells(z, 3) = "" And .Cells(z, WertSpalte) > "" Then 'Summe Ebene 1: es wird ein Ratio zu Eb1_Sum berechnet
.Cells(z, s).Value = CDbl(.Cells(z, WertSpalte)) / Eb1_Sum
.Cells(z, s).NumberFormat = "0.0%_ ;-0.0%_ ;-"
Else
.Cells(z, s).Value = CDbl(.Cells(z, WertSpalte)) / Eb2_Sum
.Cells(z, s).NumberFormat = "0.0%;-0.0%;-"
End If
End If
End If
Next
Next
'Formel einfügen 'Umsatzentwicklung
With .Cells(KopfZeile + 1, ESue).Resize(LetzteZeile - KopfZeile, AnzEint - 1)
.FormulaR1C1 = "=IFERROR((RC[" & -AnzEint * 2 - 1 & "] - RC[" & -AnzEint * 2 - 2 & "]) / RC[" & -AnzEint * 2 - 2 & "],0)"
.NumberFormat = "0.0%;-0.0%;-"
End With
End With
End Sub
Mit der Zahlenformatierung ist es noch ein Bischen holprig.
VG
Yal