Excel VBA-Summe mit Dynamikbereich

Question

Ich versuche, ein Excel-Makro zu erstellen, das eine Summe von Werten in Spalte A berechnet, wobei ein bestimmter dynamischer Bereich verwendet wird.

Basis Excel Beispiel Screenshot unten enthalten:

Das Endziel eine Schleife durch die Zellen in Spalte B, bis eine "0" erreicht ist. Wenn eine "0" erreicht ist, wird in Spalte A derselben Zeile eine Summe aller Werte in Spalte A berechnet, bis eine neue "0" in Spalte B erreicht ist. Also sollte in diesem Basisbeispiel A1 enthalten = Summe (A2: A7) und A8 sollte die Summe der Werte A9 bis A14 enthalten.

Mein bisheriger Fortschritt war noch immer ziemlich neu bei allen VBA-Sachen.

Sub sumtill0() 
' 
' sumtill0 Macro 
' 

' 
Cells(ActiveCell.Row, 1).Select 
If Sheets("Blad1").Cells(2, 1).Value = nil And Sheets("Blad1").Cells(2, 1).Value <> "0" Then 
    Sheets("Blad1").Activate 
    Cells(2, 1).Range("A1").Select 
     Else 
    Dim artTekst As String 
    If Sheets("Blad1").Cells(1, 2).Value = "0" Then 
     Sheets("Blad1").Cells(1, 1).Fomula = "=SUM()" 
    Else 
     If Sheets("Blad1").Cells(1, 2).End(xlDown).Value = "0" Then 
      Sheets("Blad1").Cells(1, 1).End(xlDown).Offset(1, 0).Value = "0" 
      Sheets("Blad1").Cells(1, 1).End(xlDown).Fomula = "=SUM(???)" 
      ActiveCell.Value = Sheets("Blad1").Cells(1, 2).End(xlDown).Offset(0, -2).Value 
    End If 

End If 

End If 

End Sub 

Thanks :)

Answer 1

Ich glaube, das tut, was Sie wollen. Es verwendet die Find-Methode, um aufeinanderfolgende Nullen zu finden, und summiert den Bereich zwischen jedem Paar. Wenn es zu dem Startwert zurückkehrt, summiert es sich zu dem unteren Wert (nicht sicher, was passieren soll, wenn der erste Wert in B nicht Null ist).

Sub x() 

Dim rFind As Range, s As String, r1 As Range 

With Range("B1", Range("B" & Rows.Count).End(xlUp)) 
    Set rFind = .Find(What:=0, After:=.Cells(.Cells.Count), LookIn:=xlFormulas, _ 
         Lookat:=xlWhole, SearchDirection:=xlNext, searchFormat:=False) 
    If Not rFind Is Nothing Then 
     s = rFind.Address 
     Do 
      Set r1 = rFind 
      Set rFind = .FindNext(rFind) 
      If rFind.Address = s Then 
       Set rFind = .Cells(.Cells.Count) 
       r1.Offset(, -1).Value = Application.Sum(Range(r1.Offset(1, -1), rFind.Offset(, -1))) 
       Exit Sub 
      End If 
      r1.Offset(, -1).Value = Application.Sum(Range(r1.Offset(1, -1), rFind.Offset(-1, -1))) 
     Loop While rFind.Address <> s 
    End If 
End With 

End Sub