如何通过列标题在VBA代码中实现列自动求和？列位置时常变动

原代码的问题很明显：硬绑定了F、G、H列的位置，一旦这些列被移动、插入或删除，代码直接失效，而且重复代码太多，维护起来麻烦。下面是按列标题定位的优化方案，不管列怎么调整位置，只要标题不变就能正常工作：

Sub SumColumnsByHeader()
    Dim ws As Worksheet
    Dim headerRange As Range
    Dim targetHeaders As Variant
    Dim header As Variant
    Dim foundCell As Range
    Dim col As Integer
    Dim lastRow As Long
    Dim sumCell As Range
    
    ' 设置目标工作表，可根据实际修改
    Set ws = ThisWorkbook.ActiveSheet
    ' 定义需要求和的列标题，替换成你实际的标题
    targetHeaders = Array("销售额", "成本", "利润") 
    
    ' 定位表头行（假设表头在第1行，不是的话改数字）
    Set headerRange = ws.Rows(1)
    
    ' 遍历每个目标标题
    For Each header In targetHeaders
        ' 精准查找标题所在列
        Set foundCell = headerRange.Find(What:=header, LookIn:=xlValues, LookAt:=xlWhole)
        
        If Not foundCell Is Nothing Then
            col = foundCell.Column
            ' 获取该列最后一行有数据的行号
            lastRow = ws.Cells(ws.Rows.Count, col).End(xlUp).Row
            
            ' 跳过只有表头无数据的列
            If lastRow > 1 Then
                ' 求和单元格放在数据最后一行的下一行
                Set sumCell = ws.Cells(lastRow + 1, col)
                ' 写入求和公式（保持原代码的相对地址逻辑）
                sumCell.Formula = "=SUM(" & ws.Range(ws.Cells(2, col), ws.Cells(lastRow, col)).Address(False, False) & ")"
                ' 可选：给求和单元格加格式，比如加粗
                sumCell.Font.Bold = True
            End If
        Else
            ' 找不到标题时提示（可按需删掉）
            MsgBox "未找到列标题：" & header, vbExclamation
        End If
    Next header
End Sub

关键说明 #

• 灵活定位：用Find方法根据标题找列，彻底摆脱固定列标的限制
• 易扩展：要加新的求和列，只需要在targetHeaders数组里加标题，不用重复写代码
• 容错处理：找不到标题时会弹出提示，避免代码报错崩溃
• 适配空列：如果某列只有表头没有数据，会自动跳过求和，避免生成无效公式

使用步骤 #

1. 把targetHeaders数组里的示例标题改成你实际需要求和的列标题
2. 如果表头不在第1行，修改headerRange = ws.Rows(1)里的数字为表头所在行号
3. 运行宏即可自动完成指定列的求和

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