来自不同表格的动态范围总和

Sum dynamic range from different tables

我想知道您是否可以帮我找到一种方法来编写一个 vba 代码来对不同表中的动态范围求和。

我正在尝试对来自不同表(其行数会发生变化)的值求和。

这些表都在同一个 sheet 上,看起来像这样:

我尝试通过宏记录器编写代码(请参见下文),但是,我正在努力寻找如何使其动态化。

Range("B3").Select
ActiveCell.FormulaR1C1 = "=SUM(R[6]C:R[9]C)"
Range("B4").Select
ActiveCell.FormulaR1C1 = "=SUM(R[12]C:R[14]C)"
Range("B5").Select
ActiveCell.FormulaR1C1 = "=SUM(R[17]C:R[19]C)"

感谢您的帮助!

汇总范围

Option Explicit

Sub SumUpWeeks()
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    
    Dim dlCell As Range: Set dlCell = ws.Cells(ws.Rows.Count, "B").End(xlUp)
    Dim srg As Range: Set srg = ws.Range("A7", ws.Cells(dlCell.Row, "A"))
    
    Dim drg As Range: Set drg = ws.Range("A3:B5")
    
    Dim drrg As Range
    Dim fCell As Range
    Dim lCell As Range
    Dim sString As String
    Dim sIndex As Variant
    
    For Each drrg In drg.Rows
        sString = CStr(drrg.Cells(1).Value)
        ' Get week index.
        sIndex = Application.Match(sString, srg, 0)
        If IsNumeric(sIndex) Then ' week found
            ' In column 'B' skip 'Money Spent'.
            Set fCell = srg.Cells(sIndex).Offset(2, 1)
            Set lCell = ws.Range(fCell, dlCell) _
                .Find("", dlCell, xlValues, xlWhole)
            If lCell Is Nothing Then ' last week
                If dlCell.Row = fCell.Row Then ' one entry
                    drrg.Cells(2).Formula = "=" & fCell.Address
                Else ' multiple entries
                    drrg.Cells(2).Formula = "=SUM(" & fCell.Address _
                        & ":" & dlCell.Address & ")"
                End If
            Else ' not last week
                If lCell.Row = fCell.Row Then ' one entry
                    drrg.Cells(2).Formula = "=" & fCell.Address
                Else ' multiple entries
                    drrg.Cells(2).Formula = "=SUM(" & fCell.Address _
                        & ":" & lCell.Offset(-1).Address & ")"
                End If
            End If
        Else ' week not found
            drrg.Cells(2).Value = vbNullString
        End If
    Next drrg
    
    MsgBox "Weeks summed up.", vbInformation
    
End Sub