VBA Microsoft Word - 序号

Question

我已经手动完成了此操作，我想用从 1 开始一直到 ZXZ 在 word 文档中最后一次出现的序列号替换每个 ZXZ 实例。

基本上，我想要实现的是在特定的 word 文档中运行 word VBA 宏，其中 VBA 宏从文件顶部开始搜索，查找 ZXZ 的每个出现，将第一次出现的 ZXZ 替换为“1”，然后是“2”的下一个出现顺序，直到在 word 文档中找到最后一个 ZXZ。

示例 word 文档可能包含：

元素 ZXZ 元素ZXZ ... 元素ZXZ

运行 vba word 宏后，我想得到：

元素 1 元素 2 ... 元素 25

我已经使用此代码完成了此操作，但我想执行“while”循环或查找 ZXZ 的每次出现并将其替换为从“1”开始的序号

    Sub my_prov_MDList()
'
' my_prov_MDList Macro
'
'
    Selection.MoveUp Unit:=wdScreen, Count:=7
    Selection.HomeKey Unit:=wdLine
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "ZXZ"
        .Replacement.Text = "1"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    With Selection
        If .Find.Forward = True Then
            .Collapse Direction:=wdCollapseStart
        Else
            .Collapse Direction:=wdCollapseEnd
        End If
        .Find.Execute Replace:=wdReplaceOne
        If .Find.Forward = True Then
            .Collapse Direction:=wdCollapseEnd
        Else
            .Collapse Direction:=wdCollapseStart
        End If
        .Find.Execute
    End With
    With Selection.Find
        .Text = "ZXZ"
        .Replacement.Text = "2"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    With Selection
        If .Find.Forward = True Then
            .Collapse Direction:=wdCollapseStart
        Else
            .Collapse Direction:=wdCollapseEnd
        End If
        .Find.Execute Replace:=wdReplaceOne
        If .Find.Forward = True Then
            .Collapse Direction:=wdCollapseEnd
        Else
            .Collapse Direction:=wdCollapseStart
        End If
        .Find.Execute
    End With

''''我基本上一直重复上面的代码，直到我达到 25，这通常是每个文档中存在的 ZXZ 实例的数量。

Answer 1

可能不是最有效的方法...但它是：

Option Explicit

Function countOccurrences(someString As String) As Integer

    Dim iCount As Long

    If someString > "" Then
        Application.ScreenUpdating = False
        With Selection
            .HomeKey Unit:=wdStory
            With .Find
                .ClearFormatting
                .Text = someString
                Do While .Execute
                    iCount = iCount + 1
                    Selection.MoveRight
                Loop
            End With
        End With
        Application.ScreenUpdating = True
    End If

    countOccurrences = iCount

End Function

Sub my_prov_MDList()

    Dim counter As Long
    For counter = 1 To countOccurrences("ZXZ")

        Selection.MoveUp Unit:=wdScreen, count:=7
        Selection.HomeKey Unit:=wdLine
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting

        With Selection.Find
            .Text = "ZXZ"
            .Replacement.Text = CStr(counter)
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With

        Selection.Find.Execute

        With Selection
            If .Find.Forward = True Then
                .Collapse Direction:=wdCollapseStart
            Else
                .Collapse Direction:=wdCollapseEnd
            End If

            .Find.Execute Replace:=wdReplaceOne

            If .Find.Forward = True Then
                .Collapse Direction:=wdCollapseEnd
            Else
                .Collapse Direction:=wdCollapseStart
            End If

            .Find.Execute
        End With

    Next

End Sub

刚刚添加了一个函数来计算“ZXZ”出现的次数，因此可以将其用作循环限制

Answer 2

效率更高：

Sub Demo()
Application.ScreenUpdating = False
Dim i As Long
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "ZXZ"
    .Replacement.Text = ""
    .Format = False
    .Forward = True
    .Wrap = wdFindStop
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    i = i + 1
    .Text = i
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
MsgBox i & " instances found."
End Sub