如何在VBA中向下填充宏生成的公式并使行引用递增1

问题说明 #

我用VBA宏生成公式填入D15，需要让下方5个单元格的公式里，所有行引用逐个加1。比如：

D15公式：=D24+D49+D82+D116+D144+D179
D16公式：=D25+D50+D83+D117+D145+D180
以此类推到D20。

以下是我写的初始代码，卡在批量修改行引用的步骤：

Sub AA()

Dim thej As Range

Dim result As String
result = ""
Dim vvv As String
vvv = "Other"

For Each thej In Range("A20:A200")    
    If thej.Value = vvv Then
        thej.Activate
        ActiveCell.Offset(0, 3).Activate
    
        func = ActiveCell.Address(RowAbsolute:=False, ColumnAbsolute:=False)

        If result = "" Then
            result = "=" & func
        Else
            result = result & "+" & func
        End If
    End If
    
Next thej

ActiveSheet.Range("D15").Formula = result

'figure out how to add 1 to cell references and put in next cell D# down
        
End Sub

试过给func加1、转文本字符串，结果都是引用末尾带"+1"；拆分数组也没搞定，求可行方法。

三种解决方法 #

方法1：用Excel自动填充（最简单高效） #

你生成公式时用的是相对引用（RowAbsolute:=False），Excel自带的FillDown功能会自动帮你把每个引用的行号加1，直接修改代码最后部分就行：

' 写入初始公式到D15
ActiveSheet.Range("D15").Formula = result
' 填充下方5个单元格（D16到D20）
ActiveSheet.Range("D15:D20").FillDown

这是最省心的方法，完全符合需求，不需要手动处理字符串。

方法2：手动拆分修改公式文本 #

如果必须手动处理字符串（比如有特殊自定义逻辑），可以拆分公式里的每个单元格引用，单独给行号加1：

' 写入初始公式到D15
ActiveSheet.Range("D15").Formula = result

' 处理下方5个单元格
Dim i As Integer
Dim originalFormula As String
Dim formulaParts As Variant
Dim part As Variant
Dim newFormula As String

originalFormula = Mid(result, 2) ' 去掉开头的"="
formulaParts = Split(originalFormula, "+") ' 拆成单个单元格引用

For i = 1 To 5
    newFormula = "="
    For Each part In formulaParts
        ' 提取列字母和行号，行号加i
        Dim colLetter As String
        Dim rowNum As Integer
        colLetter = Left(part, 1) ' 假设列是单字母（比如D），如果是多字母需要调整逻辑
        rowNum = CInt(Mid(part, 2)) + i
        newFormula = newFormula & colLetter & rowNum & "+"
    Next part
    ' 删掉最后一个多余的"+"
    newFormula = Left(newFormula, Len(newFormula) - 1)
    ' 写入到对应单元格
    ActiveSheet.Range("D15").Offset(i, 0).Formula = newFormula
Next i

注意：如果你的表格有双字母列（比如AB），需要修改提取列字母的逻辑，比如循环判断字符是否为字母。

方法3：用R1C1格式公式（更灵活） #

改用R1C1格式的相对引用，能更精准控制行偏移，还能兼容多字母列：

Sub AA()
Dim thej As Range
Dim result As String
result = ""
Dim vvv As String
vvv = "Other"

For Each thej In Range("A20:A200")    
    If thej.Value = vvv Then
        ' 计算当前单元格相对于D15的行偏移量
        Dim rowOffset As Integer
        rowOffset = thej.Row - 15 ' D15的行号是15，偏移量=目标行-15
        ' 生成R1C1相对引用：R[偏移量]C[3]（C[3]对应第4列，即D列）
        func = "R[" & rowOffset & "]C[3]"
        If result = "" Then
            result = "=" & func
        Else
            result = result & "+" & func
        End If
    End If
Next thej

' 写入D15的R1C1公式
ActiveSheet.Range("D15").FormulaR1C1 = result
' 填充下方5个单元格
ActiveSheet.Range("D15:D20").FillDown

这种方法逻辑更清晰，不管列名是单字母还是多字母，都能正确处理相对偏移。

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