在Excel VBA中实现循环汇总指定行数及按国家批量求和写入

我经常处理这类Excel批量操作需求，给你分两个部分拆解实现，代码直接可用，注释也写清楚了，你可以根据自己的实际数据结构调整。

一、按国家汇总数值并批量写入每行C列 #

这个需求核心是先全局计算每个国家的总和，再批量填充，比每行用SUMIF计算效率高得多，大数据量下优势特别明显。

实现代码 #

Sub BatchFillCountryTotal()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim countryDict As Object
    Dim i As Long
    Dim countryName As String
    Dim totalValue As Double
    
    ' 替换成你要处理的工作表名称
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    ' 获取数据最后一行（假设A列是国家名称，B列是需要汇总的数值）
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 创建字典存储「国家-总和」的键值对
    Set countryDict = CreateObject("Scripting.Dictionary")
    
    ' 第一步：遍历所有数据，计算每个国家的总数值
    For i = 2 To lastRow ' 假设第1行是表头，从第2行开始处理数据
        countryName = Trim(ws.Cells(i, "A").Value) ' 去除国家名称前后空格
        totalValue = ws.Cells(i, "B").Value
        
        If countryDict.Exists(countryName) Then
            ' 国家已存在，累加数值
            countryDict(countryName) = countryDict(countryName) + totalValue
        Else
            ' 新国家，添加到字典
            countryDict(countryName) = totalValue
        End If
    Next i
    
    ' 第二步：遍历数据，把对应国家的总和写入C列
    For i = 2 To lastRow
        countryName = Trim(ws.Cells(i, "A").Value)
        ws.Cells(i, "C").Value = countryDict(countryName)
    Next i
    
    ' 释放对象，避免内存占用
    Set countryDict = Nothing
    MsgBox "国家汇总填充完成！", vbInformation
End Sub

关键说明 #

• 如果你的国家列不是A列、数值列不是B列，直接修改代码里的"A"、"B"为对应列标即可；
• 字典的作用是去重+存储唯一值，确保每个国家只计算一次总和；
• 两次遍历的逻辑：先算总和再填充，比每行调用SUMIF循环计算至少快3倍以上（数据量越大差距越明显）。

二、循环汇总指定行数的数据 #

这里默认需求是每N行做一次数值汇总，比如每3行把B列数值求和，写入该组最后一行的D列（你可以自行调整汇总结果的写入位置）。

实现代码 #

Sub SummarizeBySpecifiedRows()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim specifiedRows As Integer ' 自定义要汇总的行数，比如每3行一次
    Dim i As Long
    Dim sumRange As Range
    
    ' 替换成你的工作表名称
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    specifiedRows = 3 ' 修改成你需要的指定行数
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    
    ' 按指定行数步长循环处理
    For i = 2 To lastRow Step specifiedRows
        ' 确定当前要汇总的行范围（避免最后一组不足指定行数的情况）
        Set sumRange = ws.Range(ws.Cells(i, "B"), ws.Cells(Application.Min(i + specifiedRows - 1, lastRow), "B"))
        ' 把汇总值写入指定位置（这里是每组最后一行的D列）
        ws.Cells(Application.Min(i + specifiedRows - 1, lastRow), "D").Value = Application.Sum(sumRange)
        ' 可选：给汇总行加格式区分（比如加粗）
        ws.Cells(Application.Min(i + specifiedRows - 1, lastRow), "D").Font.Bold = True
    Next i
    
    MsgBox "指定行数汇总完成！", vbInformation
End Sub

关键说明 #

• 修改specifiedRows = 3为你需要的行数（比如每5行就改成5）；
• 如果要把汇总值写入其他位置，比如每组第一行的E列，把Cells里的行号改成i，列标改成"E"即可；
• Application.Min的作用是处理最后一组不足指定行数的情况，避免代码报错。

三、一次性执行两个操作 #

如果需要一键完成所有任务，可以写一个主程序调用上面两个Sub：

Sub RunAllProcesses()
    ' 先执行国家汇总填充
    BatchFillCountryTotal
    ' 再执行指定行数汇总
    SummarizeBySpecifiedRows
End Sub

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