Excel VBA动态选择单元格并填充拼接公式的实现问题

看起来你是想实现这么个需求：让用户手动点选两个单元格（比如源状态和目标状态列里的任意一个单元格），然后自动生成拼接公式，把这两列对应行的值去掉空格后用-连起来，而且这个公式能自动填充到数据的最后一行，对吧？

你现在的代码问题出在：用Application.InputBox(Type:=8)拿到的是Range对象，但直接把它拼进公式字符串里时，VBA会默认取这个Range的当前值，而不是单元格的引用地址。比如你选了D2（值是IN），拼出来的公式里就直接是IN而不是D2，这样公式就固定死了，下拉的时候不会自动对应到D3、D4这些行。

给你修正一下代码，顺便优化下逻辑，让它更实用：

修正后的完整代码 #

Sub AddDynamicConcatenateFormula()
    Dim originCell As Range
    Dim destCell As Range
    Dim lastDataRow As Long
    Dim fillRange As Range
    
    ' 让用户选择源状态单元格，点取消就退出
    On Error Resume Next
    Set originCell = Application.InputBox("请选择源状态所在单元格", "选择源单元格", Type:=8)
    If originCell Is Nothing Then Exit Sub
    
    Set destCell = Application.InputBox("请选择目标状态所在单元格", "选择目标单元格", Type:=8)
    If destCell Is Nothing Then Exit Sub
    On Error GoTo 0
    
    ' 找到数据源的最后一行（这里以源状态列的最后非空行为准）
    lastDataRow = Cells(Rows.Count, originCell.Column).End(xlUp).Row
    
    ' 确定要填充公式的区域：从当前激活单元格到同列的最后一行
    Set fillRange = Range(ActiveCell, Cells(lastDataRow, ActiveCell.Column))
    
    ' 生成带相对引用的R1C1公式，这样下拉时会自动对应每行的单元格
    fillRange.FormulaR1C1 = "=CONCATENATE(TRIM(" & originCell.Address(RowAbsolute:=False, ColumnAbsolute:=False, ReferenceStyle:=xlR1C1) & "),""-"",TRIM(" & destCell.Address(RowAbsolute:=False, ColumnAbsolute:=False, ReferenceStyle:=xlR1C1) & "))"
End Sub

关键修正点说明 #

• 获取单元格引用而不是值：用originCell.Address(...)来提取单元格的R1C1格式相对引用地址，这样拼进公式里的是动态的单元格位置，下拉时会自动对应到当前行的目标单元格，比如从D2自动变成D3、D4。
• 错误处理：加了On Error Resume Next和判断If ... Is Nothing，防止用户点取消按钮导致代码崩溃。
• 自动填充到最后一行：先找到数据源的最后一行，直接把公式批量填充到整个区域，比单个单元格填完再下拉要高效得多。

额外小优化 #

如果你习惯用A1格式的公式，也可以把FormulaR1C1改成Formula，然后地址用originCell.Address(RowAbsolute:=False, ColumnAbsolute:=False)，这样生成的就是A1样式的相对引用公式，效果是完全一样的。

备注：内容来源于stack exchange，提问作者MisterBeans