Найти текст в скобках и изменить определенные вхождения - PullRequest
0 голосов
/ 20 октября 2019

У меня есть такой текст

Цитата [1, 2, 3] Другие цитаты [2] Еще одна цитата [3, 2]

Япытаясь заменить на другую нумерацию.

Цитата [x1, x2, x3] Другая цитата [x2] Еще одна цитата [x3, x2]

У меня 200 различных цитат в текстовом документе.

Из примеров, которые удалось взломать это решение, слишком медленный, как мне его улучшить ?

    Sub ChangeText()
    Dim cDoc As Word.Document
    Dim cRng As Word.Range

    Set cDoc = ActiveDocument


    Set cRng = cDoc.Content


    cRng.Find.ClearFormatting
    With cRng.Find
        .Forward = True
        .Text = "["
        .Wrap = wdFindStop
        .Execute
        Do While .Found
            cRng.Collapse Word.WdCollapseDirection.wdCollapseEnd
            cRng.MoveEndUntil Cset:="]", Count:=Word.wdForward
            For x = 1 To 200
               With cRng.FormattedText.Find
                .ClearFormatting
                .Text = "[" & Cstr(x) & "]"
                .Replacement.Text = "[x" & Cstr(x) & "]"
                .Execute replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue
               End With
            Next x
            cRng.Collapse Word.WdCollapseDirection.wdCollapseEnd
            .Execute
        Loop
    End With
End Sub

1 Ответ

0 голосов
/ 20 октября 2019

Так что я исправил скрипт

Sub ChangeText()


    Dim cDoc As Word.Document
    Dim cRng As Word.Range
    Set cDoc = ActiveDocument
    Set cRng = cDoc.Content
    cRng.Find.ClearFormatting

    'Dim dic As Dictionary
    'Set dic = New Dictionary

    Dim c As Object
    Set c = CreateObject("Scripting.Dictionary")
    c.Add "x1", "1"
    c.Add "x2", "62"
    c.Add "x3", "2"

With cRng.Find
    .Forward = True
    .Text = "["
    .Wrap = wdFindStop
    .Execute
    Do While .Found

        cRng.Collapse Word.WdCollapseDirection.wdCollapseEnd
        cRng.MoveEndUntil Cset:="]", Count:=Word.wdForward

        Dim TextStr As String
        Dim Result() As String
        TextStr = cRng.FormattedText.Text
        Result() = Split(TextStr, ",")
        For i = LBound(Result()) To UBound(Result())
                Dim temp As String
                temp = CStr(LTrim(Result(i)))
                Result(i) = c(temp)
        Next i
        Debug.Print "before: " & cRng.FormattedText.Text

        cRng.FormattedText.Text = Join(Result, ", ")
        Debug.Print "after:" & cRng.FormattedText.Text
        cRng.Collapse Word.WdCollapseDirection.wdCollapseEnd
        .Execute
    Loop
End With        
End Sub
...