Excel VBA实现多工作表Index/Match、求和及数据回写需求

需求说明 #

现有工作簿包含固定的Control和Sheet2工作表，已基于Sheet2的唯一值创建多个新工作表，需实现以下功能：

• 自动在新工作表中写入Index/Match公式，从Control表提取余额（替代手动输入），公式原型：
  =INDEX(Control!N5:T8,MATCH('GBN'!Q2,Control!M5:M9,0),MATCH('GBN'!Q4,Control!N2:T2&CONTROL!N3:S3,0))
• 对Control和Sheet2以外的所有工作表，忽略R列中的非数值内容，求和R列数值，结果放入R列下一个空白单元格
• 求和结果对应的Q列单元格需显示Balance
• 将各工作表的Balance值按日期、工作表名称匹配回写至Control表的Balance列

初始代码问题 #

用户提供的求和部分代码存在错误，片段如下：

Dim ws as Worksheet
Dim lastrow as Long
If ws.Name <> "Control" and ws.Name <> "Sheet2" Then

lastrow = ws.Range("Q" & Rows.Count).End(xlUp).Row
.Range("R10").Formula = ".Sum(Range("""R4:R"""))" ----- This is incorrect

完整修正代码 #

Sub WorkbookAutomation()
    Dim ws As Worksheet
    Dim lastRowR As Long
    Dim balanceCell As Range
    Dim controlWs As Worksheet
    Dim matchRow As Long, matchCol As Long
    Dim wsName As String, wsDate As String
    
    Set controlWs = ThisWorkbook.Worksheets("Control")
    
    ' 遍历所有工作表
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Control" And ws.Name <> "Sheet2" Then
            wsName = ws.Name
            wsDate = ws.Range("Q4").Value ' 假设Q4是日期值，对应Control表的日期匹配项
            
            ' 1. 写入余额提取公式（位置可根据实际调整）
            ws.Range("Q6").Formula = "=INDEX(Control!N5:T8,MATCH('" & wsName & "'!Q2,Control!M5:M9,0),MATCH('" & wsName & "'!Q4,Control!N2:T2&Control!N3:S3,0))"
            
            ' 2. 忽略非数值，求和R列
            lastRowR = ws.Range("R" & ws.Rows.Count).End(xlUp).Row
            ' 定位R列下一个空白单元格
            Set balanceCell = ws.Range("R" & lastRowR).Offset(1, 0)
            ' 用SUMIF仅求和数字（忽略非数值内容）
            balanceCell.Formula = "=SUMIF(R4:R" & lastRowR & ","">=0"")"
            
            ' 3. 对应Q列写入"Balance"
            balanceCell.Offset(0, -1).Value = "Balance"
            
            ' 4. 回写Balance值到Control表
            matchRow = Application.Match(ws.Range("Q2").Value, controlWs.Range("M5:M9"), 0)
            matchCol = Application.Match(wsDate, controlWs.Range("N2:T2") & controlWs.Range("N3:S3"), 0)
            
            If Not IsError(matchRow) And Not IsError(matchCol) Then
                ' N列是第14列，所以列索引+13
                controlWs.Cells(matchRow + 4, matchCol + 13).Value = balanceCell.Value
            End If
        End If
    Next ws
    
    MsgBox "自动化操作完成！", vbInformation
End Sub

代码说明 #

1. 公式自动写入：通过拼接工作表名称，动态生成适配每个新工作表的Index/Match公式
2. R列求和：使用SUMIF函数仅对R列数值求和，自动定位到R列最后一个空白单元格写入结果
3. Balance标注：通过单元格偏移，在对应Q列位置写入"Balance"
4. 回写Control表：通过两次Match匹配工作表名称和日期组合，精准定位后写入Balance值，避免匹配错误

内容的提问来源于stack exchange，提问作者Amy