来自不同表格的动态范围总和
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
我想知道您是否可以帮我找到一种方法来编写一个 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