VBA Excel小计动态范围不起作用

Question

我有这段代码，是我从其他帖子中借来的，并对其进行了编辑（或至少尝试过）编辑，以用于汇总一些动态范围。我使用带有0、1和2的键列。我希望代码在每个1之前添加所有对应的列，直到命中2，然后将小计与2一起放入列中。目前，我的代码一直在向后运行，因此将错误的小计放入其中。我的代码段。

'count all 1's in each section till next 2 for subtotaling each section
With Range("P13:P" & lRow1)
Set rFind = .Find(What:=2, LookIn:=xlFormulas, SearchOrder:=xlByRows, _
                  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(, -5).Value = Application.Sum(Range(r1.Offset(-1, -5), r1.Offset(, -5)))
            Exit Sub
        End If
        r1.Offset(, -5).Value = Application.Sum(Range(r1.Offset(-1, -5), rFind.Offset(, -5)))
    Loop While rFind.Address <> s
End If
End With

即使我输入了这个问题，我仍在考虑采用其他方法。我的代码在每个空白行处放置一个0，目前我将其设置为在1st 1上方的行中放置一个0。这样，我可能会找到1st 0，然后将所有1加到我达到2，然后找到下一个0，依此类推。这有道理吗？

下面是宏当前产生的图片。

Answer 1

您实际上可以使用公式来实现

=IF(P3=2,SUMIF($P$1:P2,1,$K$1:K2)-SUMIF($P$1:P2,2,$K$1:K2),"")

在K的每个单元格中，P列中有2。可以使用VBA插入。

---

这是直接的VBA解决方案：

Sub x()

Dim r As Range

For Each r In Range("K:K").SpecialCells(xlCellTypeConstants).Areas
    r(r.Count + 1).Value = Application.Sum(r)
Next r

End Sub