简体   繁体   English

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

[英]VBA Excel Subtotal Dynamic Ranges Not Working

I have this snippet of code that I've borrowed from other post and edited(or at least tried) that I'm trying to use to subtotal some dynamic ranges. 我有这段代码是我从其他帖子中借来的,并对其进行了编辑(或至少尝试过),以试图对一些动态范围进行小计。 I use a key column with 0's, 1's, and 2's. 我使用带有0、1和2的键列。 I want the code to add all the coorosponding columns across from each 1 until it hits a 2 and then put the subtotal in the column with the 2. Currently, my code keeps running backwards so it is putting the wrong subtotals in. Below is a snippet of my code. 我希望代码在每个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

Even now that I type this question out I'm thinking I should take a different approach. 即使现在我输入了这个问题,我仍认为我应该采用其他方法。 My code places a 0 at each blank line and I currently have it set to place a 0 on the line above the 1st 1. With that, I could maybe find the 1st 0 then add all the 1's till i reach a 2 then find the next 0 and so forth. 我的代码在每个空白行处放置一个0,目前我将其设置为在1st 1上方的行中放置一个0。这样,我可能会找到1st 0,然后将所有1加到我达到2,然后找到下一个0,依此类推。 Does that make sense? 那有意义吗?

Below is a picture of what the macro is currently producing. 下面是该宏当前产生的图片。

宏输出片段

You can actually do this with a formula 您实际上可以使用公式来执行此操作

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

in each cell in K where there is a 2 in column P. Could use VBA to insert this. 在K的每个单元格中,P列中有2。可以使用VBA插入此单元格。

在此处输入图片说明


Here's a straight VBA solution: 这是直接的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

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM