首先得说，你当前的代码其实没做任何和「合并单元格」相关的操作——它只是把Notes字段设置成了数据透视表的行字段，这就是为什么代码能运行但看不到你想要的合并效果。

第一步：用VBA实现透视表重复标签的合并 #

要合并透视表中重复的标签单元格，核心是开启透视表的MergeLabels属性，而不是单纯设置字段方向。这里给你修正后的代码：

Sub MergePivotLabels()
    Dim targetPivot As PivotTable
    ' 定位到目标工作表的第一个数据透视表
    Set targetPivot = Worksheets("Executive Outline").PivotTables(1)
    
    ' 确保Notes字段作为行字段存在（如果之前没设置的话）
    With targetPivot.PivotFields("Notes")
        .Orientation = xlRowField
        .Position = 1 ' 把它设为第一个行字段，保证合并逻辑生效
    End With
    
    ' 开启标签合并功能——这才是实现单元格合并的关键
    targetPivot.MergeLabels = True
    
    ' 刷新透视表，确保格式立即生效
    targetPivot.RefreshTable
End Sub

运行这段代码后，你应该能看到透视表中Notes列的重复标签被自动合并成一个单元格了。

第二步：自动把合并后的透视表复制到Word #

如果要完成「合并→复制到Word」的完整自动化流程，可以用下面的代码，它会帮你完成从合并到粘贴的全步骤：

Sub MergePivotAndCopyToWord()
    Dim targetPivot As PivotTable
    Set targetPivot = Worksheets("Executive Outline").PivotTables(1)
    
    ' 先执行标签合并
    With targetPivot.PivotFields("Notes")
        .Orientation = xlRowField
        .Position = 1
    End With
    targetPivot.MergeLabels = True
    targetPivot.RefreshTable
    
    ' 复制整个透视表（包括标签和数据区域）
    targetPivot.TableRange2.Copy
    
    ' 启动或打开Word应用
    Dim wordApp As Object
    Dim wordDoc As Object
    On Error Resume Next
    ' 先尝试获取已打开的Word实例
    Set wordApp = GetObject(, "Word.Application")
    If Err.Number <> 0 Then
        ' 如果没有打开的Word，就新建一个
        Set wordApp = CreateObject("Word.Application")
    End If
    On Error GoTo 0
    wordApp.Visible = True ' 让Word窗口可见，方便你查看结果
    
    ' 创建新的Word文档（也可以改成打开现有文档：wordApp.Documents.Open("你的文档路径")）
    Set wordDoc = wordApp.Documents.Add
    
    ' 把复制的透视表粘贴到Word里
    wordDoc.Range.Paste
    
    ' 释放对象，避免内存占用
    Set wordDoc = Nothing
    Set wordApp = Nothing
End Sub

一些额外提醒 #

• 确认你的透视表中Notes字段确实有重复的标签值，不然合并效果不明显
• 如果合并后的布局不是你想要的，可以在代码里添加targetPivot.RowAxisLayout xlTabularRow，强制透视表用表格布局显示
• 运行代码前，确保Excel和Word的宏安全设置允许执行宏（如果被禁用了，去「文件→选项→信任中心」调整）

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