Marktanteile mit VBA statt per Hand

Susanne · 2023-02-10T11:30:45+00:00

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

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

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

Marktanteile mit VBA statt per Hand

Forumthread: Marktanteile mit VBA statt per Hand

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Marktanteile mit VBA statt per Hand

Forumthread: Marktanteile mit VBA statt per Hand

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

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread