Sub CalculateMergedCellSums()
Dim ws As Worksheet
Dim mergedRange As Range
Dim cell As Range
Dim sumF As Double
Dim lastRow As Long
Dim i As Long
' 设置工作表
Set ws = ThisWorkbook.Sheets("Sheet1")
' 获取最后一行
lastRow = ws.Cells(ws.Rows.Count, 4).End(xlUp).Row
' 遍历D列
For i = 2 To lastRow ' 从第2行开始，假设第1行是标题行
' 检查是否为合并单元格的起始单元格
If ws.Cells(i, 4).MergeCells Then
' 获取合并单元格区域
Set mergedRange = ws.Cells(i, 4).MergeArea
' 初始化和
sumF = 0
' 计算合并单元格对应行的和
For Each cell In mergedRange
' 检查F列的值是否为数字
If IsNumeric(ws.Cells(cell.Row, 6).Value) Then
sumF = sumF + ws.Cells(cell.Row, 6).Value
End If
Next cell
' 将结果写入G列的第一个单元格
ws.Cells(i, 7).Value = sumF
' 清除其他行的结果
For Each cell In mergedRange
If cell.Row <> i Then
ws.Cells(cell.Row, 7).ClearContents
End If
Next cell
End If
Next i
MsgBox "计算完成！"
End Sub
代码解释
设置工作表：
Set ws = ThisWorkbook.Sheets("Sheet1")：设置要处理的工作表。
获取最后一行：
lastRow = ws.Cells(ws.Rows.Count, 4).End(xlUp).Row：获取D列的最后一行。
遍历D列：
For i = 2 To lastRow：从第2行开始遍历D列，假设第1行是标题行。
检查是否为合并单元格的起始单元格：
If ws.Cells(i, 4).MergeCells：检查当前单元格是否为合并单元格的起始单元格。
获取合并单元格区域：
Set mergedRange = ws.Cells(i, 4).MergeArea：获取合并单元格区域。
初始化和：
sumF = 0：初始化和为0。
计算合并单元格对应行的和：
For Each cell In mergedRange：遍历合并单元格区域。
If IsNumeric(ws.Cells(cell.Row, 6).Value)：检查F列的值是否为数字。
sumF = sumF + ws.Cells(cell.Row, 6).Value：将F列对应行的值累加到sumF。
将结果写入G列的第一个单元格：
ws.Cells(i, 7).Value = sumF：将计算结果写入G列的第一个单元格。
清除其他行的结果：
For Each cell In mergedRange：遍历合并单元格区域。
If cell.Row <> i Then：如果当前行不是起始行，则清除G列的值。
ws.Cells(cell.Row, 7).ClearContents：清除G列的值。
示例数据假设你的数据如下：表格复制
A B C D E F
标题 水果 10
水果 15
蔬菜 5
蔬菜 10
水果 20
运行调整后的代码后，G列应该只在每个合并单元格区域的第一行显示结果：表格复制
A B C D E F G
标题 水果 10 25
水果 15
蔬菜 5 15
蔬菜 10
水果 20 20
注意事项
备份数据：
在运行VBA代码之前，建议备份你的数据，以防万一。
调整工作表名称：
如果你的工作表名称不是“Sheet1”，请在代码中将 Sheet1 替换为实际的工作表名称。
测试代码：
在运行代码之前，建议在小数据集上测试代码，确保其按预期工作。
以上亲测有效，一小点问题就是结果不是生成在合并单元格对应第一行，而是最后一行