嘿，太懂这种重复代码堆得头疼的感觉了！咱们完全可以通过抽离通用逻辑+书签分组管理的方式，把那些重复的删除代码彻底干掉，让宏的结构更清晰，以后维护也方便。

优化思路核心 #

把两组书签分别做成可管理的集合，然后写一个通用的子过程来处理“删除不需要的书签”这个操作——不管是要删除哪一组，只需要把对应的书签列表传给这个子过程就行，不用再重复写一堆判断和删除的代码。

具体实现步骤 #

1. 先定义两组书签的集合

把你的两组书签名称分别存到数组里，以后要加书签或者改名字，直接在这里改就行，不用动后面的逻辑：

' 把你的两组书签名称替换成实际的名字
Dim group1Bookmarks As Variant
group1Bookmarks = Array("书签A1", "书签A2", "书签A3") ' 场景1需要保留的书签

Dim group2Bookmarks As Variant
group2Bookmarks = Array("书签B1", "书签B2", "书签B3") ' 场景2需要保留的书签

2. 写通用的删除书签子过程

这个子过程负责接收要删除的书签列表，然后循环检查并删除——把原来重复的删除逻辑都放到这里：

Sub DeleteUnwantedBookmarks(bookmarksToDelete As Variant)
    Dim bmkName As Variant
    
    ' 遍历要删除的每个书签
    For Each bmkName In bookmarksToDelete
        ' 先判断书签存在再删除，避免报错
        If ActiveDocument.Bookmarks.Exists(bmkName) Then
            ActiveDocument.Bookmarks(bmkName).Delete
        End If
    Next bmkName
End Sub

3. 在你的场景代码里调用这个子过程

原来的两个场景代码里，删除书签的部分直接替换成调用这个通用子过程就行，剩下的粘贴逻辑保留：

' 场景1：使用组1书签，删除组2书签
Sub Scenario1_PasteData()
    ' 调用通用子过程删除不需要的书签
    DeleteUnwantedBookmarks group2Bookmarks
    
    ' 下面是你的Excel数据复制粘贴逻辑（保留原来的代码就行）
    ' 比如：
    ' Excel.Application.Workbooks("数据源.xlsx").Sheets("Sheet1").Range("A1").Copy
    ' ActiveDocument.Bookmarks("书签A1").Range.Paste
    ' ... 其他组1书签的粘贴操作
End Sub

' 场景2：使用组2书签，删除组1书签
Sub Scenario2_PasteData()
    ' 调用通用子过程删除不需要的书签
    DeleteUnwantedBookmarks group1Bookmarks
    
    ' 下面是你的Excel数据复制粘贴逻辑（保留原来的代码就行）
    ' 比如：
    ' Excel.Application.Workbooks("数据源.xlsx").Sheets("Sheet1").Range("B1").Copy
    ' ActiveDocument.Bookmarks("书签B1").Range.Paste
    ' ... 其他组2书签的粘贴操作
End Sub

进阶优化（可选） #

如果以后书签数量变多，或者你想保留指定书签、删除其他所有书签，可以用这个版本的通用子过程，更灵活：

Sub DeleteBookmarksExcept(bookmarksToKeep As Variant)
    Dim allBookmarks() As String
    ReDim allBookmarks(ActiveDocument.Bookmarks.Count - 1)
    Dim i As Integer
    Dim bmkName As String
    Dim keepIt As Boolean
    
    ' 先把所有书签名称存到临时数组（避免遍历集合时修改集合导致的错误）
    For i = 0 To ActiveDocument.Bookmarks.Count - 1
        allBookmarks(i) = ActiveDocument.Bookmarks(i + 1).Name ' Word书签索引从1开始
    Next i
    
    ' 遍历所有书签，判断是否需要保留
    For Each bmkName In allBookmarks
        keepIt = False
        ' 检查当前书签是否在保留列表里
        For Each keepName In bookmarksToKeep
            If bmkName = keepName Then
                keepIt = True
                Exit For
            End If
        Next keepName
        
        ' 不需要保留且存在的话就删除
        If Not keepIt And ActiveDocument.Bookmarks.Exists(bmkName) Then
            ActiveDocument.Bookmarks(bmkName).Delete
        End If
    Next bmkName
End Sub

调用的时候就改成：

' 场景1保留组1，删除其他
DeleteBookmarksExcept group1Bookmarks
' 场景2保留组2，删除其他
DeleteBookmarksExcept group2Bookmarks

这样优化后，不仅删掉了重复代码，以后要调整书签列表也只需要修改数组里的内容，不用动删除逻辑，维护起来轻松多啦！

内容的提问来源于stack exchange，提问作者pa.lo