编写VBA宏实现单元格内多外部工作表链接值求和

核心需求 #

生成类似 ='[文件名1.xlsm]CIIU_T apr'!T15+'[文件名2.xlsm]CIIU_T apr'!T15+... 的求和公式，批量汇总同一目录下所有同结构外部文件的指定单元格值，同时处理目标单元格已有内容时的公式追加逻辑。

修正后的完整代码 #

Sub 批量汇总外部工作表值()
    Dim destWorkbook As Workbook
    Dim templateCopy As Workbook
    Dim sourceFolder As String
    Dim sourceFile As String
    Dim sumFormula As String
    Dim targetRange As Range
    
    ' 需提前赋值destWorkbook和templateCopy，可根据实际场景补充获取逻辑
    Set targetRange = templateCopy.Worksheets("CIIU_T_AJUSTADO").Range("T13")
    
    ' 关闭自动筛选
    destWorkbook.Sheets("CIIU_T").AutoFilterMode = False
    ' 保留原有复制逻辑，无需可删除
    destWorkbook.Worksheets("CIIU_T").Range("P13:R854").Copy
    
    ' 设置外部文件所在目录，替换为你的实际路径
    sourceFolder = ThisWorkbook.Path & "\"
    sourceFile = Dir(sourceFolder & "HT_CSI_S112_005001_10100_EEA2019_*.xlsm")
    
    ' 初始化求和公式
    sumFormula = ""
    
    ' 遍历所有符合命名规则的外部文件
    Do While sourceFile <> ""
        sumFormula = sumFormula & "+'[" & sourceFile & "]CIIU_T apr'!T15"
        sourceFile = Dir()
    Loop
    
    ' 移除公式开头多余的加号
    If Left(sumFormula, 1) = "+" Then
        sumFormula = Mid(sumFormula, 2)
    End If
    
    ' 处理目标单元格赋值逻辑
    If Not IsEmpty(targetRange) Then
        ' 已有内容时追加新求和项
        Dim targetFormula As String
        targetFormula = targetRange.Formula
        ' 兼容原有公式末尾格式，避免语法错误
        If Right(targetFormula, 1) = "+" Then
            targetRange.Formula = targetFormula & Mid(sumFormula, 2)
        Else
            targetRange.Formula = targetFormula & "+" & Mid(sumFormula, 2)
        End If
    Else
        ' 无内容时直接写入完整求和公式
        targetRange.Formula = "=" & sumFormula
        ' 若需保留原有粘贴链接逻辑，取消下面注释即可
        ' targetRange.Paste Link:=True
    End If
End Sub

关键逻辑说明 #

• 批量遍历文件：用Dir函数筛选指定命名规则的外部文件，自动拼接每个文件的单元格引用
• 公式语法修正：自动移除拼接后公式开头的多余加号，避免公式报错
• 追加逻辑兼容：检查目标单元格已有公式的末尾格式，确保追加后的公式语法正确
• 取消激活依赖：避免使用Activate/Select操作，直接通过对象引用操作单元格，提升代码稳定性

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