小计和复制/粘贴(范围可变)

时间:2018-07-16 16:10:16

标签: vba variables subtotal

我正在尝试找出Excel VBA代码以将小计(= SUBTOTAL(9,__:_)公式添加到工作表中的多个“总行”(红色框)。

问题是小计的范围可以是任何高度。根据下面的图片,希望VBA代码能够识别B列中何时存在“总计”,然后继续在该行中为E到J列添加小计公式。小计公式将需要提取以上将进行平衡,直到有一个空白单元格,以便计算特定客户的金额(范围的长度由下图中的箭头表示)。范围可以是任意数量的行,因此必须完全可变。

此外,尝试在工作表的最底部(最后一行+ 2)添加一个小计,该小计应延伸到该行的最顶部(蓝色箭头)。

最后,我需要找到一种方法将客户端名称(B列中的绿色矩形)复制到总单元格(复制到C列)旁边。每个客户的发票数量可能有所不同,因此必须识别客户名称所在的位置,然后将名称复制到要计算客户总数的底部。

在此方面的任何帮助将不胜感激!

Sample Aging

Sub totalAllClients()
    Dim rng As Range, rngsb As Range, addr As String

    With Worksheets("Sheet1")
        With Intersect(.Columns(2), .UsedRange)
            Set rng = .Find(What:="total", After:=.Cells(1), MatchCase:=False, _
                            LookAt:=xlWhole, SearchDirection:=xlPrevious)
            If Not rng Is Nothing Then
                addr = rng.Address(0, 0)
                Do
                    rng.Offset(0, 1).FormulaR1C1 = _
                        "=index(c2, match(""zzz"", r1c2:r[-1]c2))"
                    rng.Offset(0, 3).Resize(, 6).FormulaR1C1 = _
                        "=subtotal(109, r[-1]c:index(c, match(""zzz"", r1c2:r[-1]c2)))"
                    Set rng = .FindNext(After:=rng)
                Loop Until rng.Address(0, 0) = addr

                rng.Offset(2, 3).Resize(1, 6).FormulaR1C1 = _
                    "=aggregate(9, 3, r2c:r" & rng.Row & "c)"
            End If
        End With
    End With

End Sub

0 个答案:

没有答案