Excel技术问询：VBA更新工作簿链接+按日期描述合并金额

Hey there, let's tackle your two Excel VBA requirements one by one with practical, tested solutions:

If you need to update all external links in your workbook to point to the same target file, this VBA macro will do the job efficiently. It loops through all existing links and replaces them with your specified target path.

Sub UpdateAllLinksToTarget()
    Dim targetPath As String
    Dim link As Variant
    
    ' 修改这里为你的目标文件完整路径
    targetPath = "C:\Your\Target\File.xlsx"
    
    ' 检查工作簿是否存在链接
    If ActiveWorkbook.LinkSources(xlExcelLinks) Is Nothing Then
        MsgBox "当前工作簿没有外部链接！", vbInformation
        Exit Sub
    End If
    
    ' 遍历所有链接并替换
    For Each link In ActiveWorkbook.LinkSources(xlExcelLinks)
        ActiveWorkbook.ChangeLink Name:=link, NewName:=targetPath, Type:=xlExcelLinks
    Next link
    
    MsgBox "所有链接已成功更新至目标地址！", vbInformation
End Sub

使用说明：

• 替换targetPath变量的值为你实际要指向的文件完整路径
• 运行宏前确保目标文件存在，否则会报错
• 建议先备份工作簿再操作

For merging rows with the same date and description and summing their amounts, we'll use a Dictionary object to track unique combinations and accumulate totals. This avoids pivot tables and gives you direct control over the output.

Sub MergeAndSumByDateAndDesc()
    Dim wsSource As Worksheet
    Dim wsResult As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim key As String
    Dim amount As Double
    Dim dict As Object
    
    ' 设置源工作表（修改为你的数据所在表名）
    Set wsSource = ThisWorkbook.Worksheets("Sheet1")
    ' 创建结果工作表（如果不存在则新建）
    On Error Resume Next
    Set wsResult = ThisWorkbook.Worksheets("合并结果")
    If Err.Number <> 0 Then
        Set wsResult = ThisWorkbook.Worksheets.Add(After:=wsSource)
        wsResult.Name = "合并结果"
    End If
    On Error GoTo 0
    
    ' 清空结果表已有数据（保留表头）
    wsResult.Cells.Clear
    wsResult.Range("A1:C1") = Array("日期", "描述", "汇总金额")
    wsResult.Range("A1:C1").Font.Bold = True
    
    ' 初始化字典
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' 获取源数据最后一行
    lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    
    ' 遍历源数据（从第2行开始，跳过表头）
    For i = 2 To lastRow
        ' 组合日期和描述作为字典的键
        key = wsSource.Cells(i, "A").Value & "|" & wsSource.Cells(i, "B").Value
        
        ' 处理金额格式：替换千分位的点，把逗号换成小数点，转成数值
        amount = CDbl(Replace(Replace(wsSource.Cells(i, "C").Value, ".", ""), ",", "."))
        
        ' 如果键已存在，累加金额；否则添加新键
        If dict.Exists(key) Then
            dict(key) = dict(key) + amount
        Else
            dict(key) = amount
        End If
    Next i
    
    ' 将字典中的数据写入结果表
    i = 2 ' 从结果表第2行开始写入
    For Each key In dict.Keys
        ' 拆分键为日期和描述
        wsResult.Cells(i, "A").Value = Split(key, "|")(0)
        wsResult.Cells(i, "B").Value = Split(key, "|")(1)
        ' 格式化汇总金额为原格式（保留千分位和逗号小数点）
        wsResult.Cells(i, "C").Value = Format(dict(key), "#,##0.00")
        wsResult.Cells(i, "C").NumberFormat = "#.##0,00" ' 匹配你的区域格式
        i = i + 1
    Next key
    
    ' 自动调整结果表列宽
    wsResult.Columns("A:C").AutoFit
    
    MsgBox "合并汇总完成！结果已保存至「合并结果」工作表", vbInformation
End Sub

使用说明：

• 修改wsSource的工作表名为你的数据所在表
• 代码会自动处理金额格式（适配示例中的千分位用点、小数点用逗号的格式）
• 结果会输出到名为「合并结果」的新工作表（如果已存在则覆盖原有内容）

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