Marktanteile mit VBA statt per Hand

Liebe VBA-Freunde,

ich bräuchte bitte eine Gedankenstütze, wie ich mich bei folgender Herausforderung vorhanteln kann:
Ich habe eine Export-Datei, in der ich gerne die Marktanteile und Umsatzentwicklung berechnen würde. Normalerweise geschah das per Hand (Spalten einfügen, Formeln eingeben und runterziehen). Jedoch ist der Aufwand mit steigender Anzahl an Exports doch etwas größer und hier würde ich gerne die Automation zu Hilfe ziehen.

Im Anhang habe ich eine exportierte Datei samt Ausgangspunkt (mit Infos) und ein Ergebnis, wie es aussehen sollte.
Nun zur Herangehensweise: Suche ich im Raum nach den "Grand Totals", verwende dann Offsets und eine Laufvariable, die dann in den neu eingefügten Spalten die Berechnung durchführt?
Ich hab da gestern immer Fehler "Überlauf" mit den ganzen Offsets erhalten. Dass auch die Groups mit zusammengefasst werden, macht es nicht gerade einfacher... (Wobei ich die auch mit etwas passendem wie "Grand Total Group 1" überschreiben könnte...)

Ich bitte um Gedankeninputs :)

LG und einen schönen Start ins Wochenende
Su

https://www.herber.de/bbs/user/157768.xlsx

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub t() With ActiveSheet .Range("H:O").Insert With .Range("I1:I" & .Cells(.Rows.Count, 5).End(xlUp).Row) .Offset(1).Resize(.Rows.Count - 1, 1).Formula = "=IF(B2="""",MAX(I$1:I1)+1,"""")" .Offset(0, 1).Resize(.Rows.Count, 3).Formula = "=IF(OR($B1="""",$B1=""""),"""",E1/INDEX(E:E,MATCH(MAX($I$1:$I1),$I:$I,0),1))" .Offset(0, 1).Resize(.Rows.Count, 6).NumberFormat = "0.0%" .Offset(0, 5).Formula = "=IF(B1="""","""",(F1-E1)/E1)" .Offset(0, 6).Formula = "=IF(B1="""","""",(G1-F1)/F1)" End With .Columns(9).Hidden = True End With End Sub

Hallo Susanne,
ich habe folgende Entwurf gestartet. Jedoch ohne der Wahnsinn der Anteile, die prinzipiell in Pivot oder PowerBI vorhanden wären.
Du brauchst nur noch zu prüfen, ob einen Fall "SummeZweiterEbene" und/oder "SummeErsteEbene" vorliegt, diese Summe merken, und die Formeln dementsprechend gestalten.
Dieser Code basiert auf die Annahme, dass
_ der Datenbereich genau zwischen die LetzteZeile (von unten kommend) und die letzte befüllte Zeile nach LetzteZeile (von unten nach oben betrachtet) liegt,
_ die Kopfzeile ist direkt über die oberste Zeile der Datenbereich
_ die Spalte fangen mit dem ersten befüllte Zelle in der Kopfzeile und
_ enden in der letzt befüllte Zelle danach (also erste leere Zelle sagt: hier ist erste Spalte nach letzter Spalte )

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 z As Long, s As Long 'Zeile und Spalte
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 z = KopfZeile + 1 To LetzteZeile
            'hier muss geprüft werden, ob eine Summe erster Ebene und/oder zweiter Ebene vorliegt
            For s = ESma To ESma + AnzEint
'                If SummeZweiterEbene > 0 Then
'                    .Cells(z, s).FormulaR1C1 = ... Formel für Anteil Wert im Zelle durch SummeZeiterEbene
'                ElseIf summeErsteEbene > 0 Then
'                    .Cells(z, s).FormulaR1C1 = ... Formel für Anteil Wert im Zelle durch SummeZeiterEbene
'                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

Viel Erfolg
VG
Yal

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

Beliebteste Forumthreads (12 Monate)

Marktanteile mit VBA statt per Hand

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread