Dynamische Formel zum addieren (VBA)

Servus Zusammen,
ich habe entweder ein Brett vorm Kopf oder das Problem ist tatsächlich nicht so einfach.
In Spalte A befinden sich "MR", "BR" und "Mod"
Bei MR sollen alle BR die darunter sind eine Summe bilden und diese Formel soll in Spalte B erscheinen
Bei BR sollen sich dann die Mods addieren.
Hier mal eine Beispieldatei in welcher ich die Formeln per Hand eingefügt habe.
Da in Spalte A immer wieder MR, BR und Mods hinzukommen oder entfallen, müssen sich dann eben die Formeln entsprechend anpassen.
https://www.herber.de/bbs/user/150688.xlsx
Ich hab schon alles mögliche mit Cases, While und If Schleifen probiert, aber irgendwie bekomm ichs im Kopf nicht zusammen.
Mit freundlichen Grüßen
Mumpfe

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
bin mir nicht sicher ob ich die Anforderung wirklich verstanden habe, aber ich denke so sollte es gehen.


Sub MRMRSummierer()
Dim xs As Worksheet
Dim LetzteZeile As Double
Dim i As Double
Dim u As Double
Dim BRSumme As Double
Dim ModSumme As Double
Set xs = ActiveSheet
'letzte Zeile ermitteln
LetzteZeile = xs.Cells(xs.Rows.Count, 1).End(xlUp).Row
'ModSumme
For i = 1 To LetzteZeile
If xs.Cells(i, 1).Value = "BR" Then
ModSumme = 0
For u = i + 1 To LetzteZeile
If xs.Cells(u, 1).Value = "Mod" Then
ModSumme = ModSumme + xs.Cells(u, 2).Value
End If
If xs.Cells(u, 1).Value = "BR" Or xs.Cells(u, 1).Value = "MR" Then Exit For
Next u
xs.Cells(i, 2).Value = ModSumme
End If
Next i
'BR SUMME
For i = 1 To LetzteZeile
If xs.Cells(i, 1).Value = "MR" Then
BRSumme = 0
For u = i + 1 To LetzteZeile
If xs.Cells(u, 1).Value = "BR" Then
BRSumme = BRSumme + xs.Cells(u, 2).Value
End If
If xs.Cells(u, 1).Value = "MR" Then Exit For
Next u
xs.Cells(i, 2).Value = BRSumme
End If
Next i
Set xs = Nothing
End Sub

Im ersten Schritt werden die Werte aus Spalte B von MOD aufaddiert bis das näschste BR bzw MR kommt.
Im zweiten Schritt werden die Werte die jetzt in Spalte B bei BR stehen aufaddiert und bei MR eingetragen.
Grüße
Theo

Sub Formel() Dim i As Long Dim anz As Long Dim s As String anz = Uebersetzung.UsedRange.Rows.Count For i = 12 To anz If Uebersetzung.Cells(i, 15) = "Marke" Then Uebersetzung.Cells(i, 15).EntireRow.Delete End If Next For i = 12 To anz s = "=SUMMEWENN(BEREICH.VERSCHIEBEN(INDIREKT(""O""&ZEILE()+1);;;VERGLEICH(""MR"";O13:O986;0);1);""BR"";BEREICH.VERSCHIEBEN(INDIREKT(""Q""&ZEILE()+1);;;VERGLEICH(""MR"";O13:O986;0);1))" If Uebersetzung.Cells(i, 15) = "MR" Then Uebersetzung.Cells(i, 17).FormulaLocal = s End If Next End Sub

Sub Formel_kopieren() Dim F As String F = Range("B1").FormulaR1C1 Debug.Print F F = Replace(F, """A""", """O""") F = Replace(F, """B""", """B""") Debug.Print F Range("P13:P986").FormulaR1C1 = F End Sub

Beliebteste Forumthreads (12 Monate)

Dynamische Formel zum addieren (VBA)

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread