excel - 不同表的动态范围总和

Question

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

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

这些表格都在同一张纸上，如下所示:

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

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)"

感谢您的帮助!

Answer 1

范围求和

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