如何用VBA实现Excel下拉选择时自动汇总对应区域金额

你的VBA代码未生效主要有以下几个核心问题，对应修正方案如下：

1. 事件模块放置错误 #

Worksheet_Change是工作表级事件，必须放在Output工作表的代码模块中（而非标准模块、Data工作表模块或ThisWorkbook）。

• 操作方式：右键点击Output工作表标签 → 查看代码 → 将代码粘贴到打开的模块中。

2. 下拉范围定义错误 #

你定义的rngRegion = Sheets("Output").Range("A1:B2")范围过大，下拉列表应该是单个单元格（比如你截图中的A2），范围错误会导致事件触发逻辑混乱。

3. 数据遍历逻辑错误 #

原代码遍历rngData的每个单元格而非每行，导致Offset偏移逻辑混乱（比如遍历到B列单元格时，Offset(0,1)会指向C列，而非Region列）。

4. 未避免循环触发事件 #

修改outputCell的值时会再次触发Worksheet_Change事件，可能导致死循环或数据异常。

修正后的完整代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngRegion As Range
    Dim rngData As Range
    Dim dataRow As Range
    Dim selectedRegion As String
    Dim totalAmount As Double
    Dim outputCell As Range
    
    ' 定义下拉列表所在单元格（根据你的场景应为A2）
    Set rngRegion = Me.Range("A2")
    ' 定义Data表的动态数据范围（自动识别最后一行）
    Set rngData = Sheets("Data").Range("A2:D" & Sheets("Data").Cells(Sheets("Data").Rows.Count, "A").End(xlUp).Row)
    ' 定义总额输出单元格（对应B2）
    Set outputCell = Me.Range("B2")
    
    ' 仅当修改的是下拉列表单元格时执行逻辑
    If Not Intersect(Target, rngRegion) Is Nothing Then
        ' 关闭事件触发，避免循环
        Application.EnableEvents = False
        
        selectedRegion = Target.Value
        totalAmount = 0
        
        ' 遍历Data表的每一行数据
        For Each dataRow In rngData.Rows
            ' 匹配Region列（B列，即第2列）
            If dataRow.Cells(2).Value = selectedRegion Then
                ' 累加Amount列（D列，即第4列）的值
                totalAmount = totalAmount + dataRow.Cells(4).Value
            End If
        Next dataRow
        
        ' 输出总额，未选中区域则清空单元格
        outputCell.Value = IIf(selectedRegion = "", "", totalAmount)
        
        ' 恢复事件触发
        Application.EnableEvents = True
    End If
End Sub

额外优化说明 #

• 动态数据范围：自动识别Data表的最后一行，避免固定行数导致漏算空行或遗漏新增数据。
• 空值处理：选中空白时自动清空输出单元格，避免残留旧数据。
• 事件安全：修改单元格前关闭EnableEvents，防止循环触发事件导致异常。

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