Hallo,

ich habe ein Skript VBA Word geschrieben, das in einem langen XML-Code (650.000 Zeilen) nach einem String sucht und jedes Mal, wenn es diesen findet, den Absatz dupliziert und den String im Original-Absatz durch einen anderen String ersetzt.

Das funktioniert auch gut mit kürzeren XML-Codes. XML-Code mit 650.000 Zeilen friert mein Word aber einfach ein. Wenn ich nur die Hälfte vom Code nehme, also ca. 350.000 Zeilen, wird das Makro immer langsamer und irgendwann friert Word auch ein.

Ich vermute, dass man das Makro viel eleganter und vor allem schneller ausführbar schreiben kann und bitte deshalb um eure Unterstützung - oder ihr habt gern noch eine andere Idee, wie ich das Script zum Laufen kriege.

Vielen Dank!

Public Const sTEXT = "k=""AAAA"""
Public Const sREPLACETEXT = "k=""BBBB"""

Sub Duplicate_And_Replace()
'Duplicates every paragraph (= line) with sTEXT and replaces sTEXT with sREPLACETEXT in the duplicate
    Dim lngSafety As Long
    Dim blnIsFound As Boolean
    On Error GoTo Error
    Selection.HomeKey Unit:=wdStory
    
    'Setting initial value for blnIsFound to make sure sTEXT does show up at all
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .TEXT = sTEXT
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    blnIsFound = Selection.Find.Execute                            'executes Find and sets blnIsFound to true or false
    
    lngSafety = 0
    Selection.HomeKey Unit:=wdStory
    While blnIsFound
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        blnIsFound = Selection.Find.Execute
'        MsgBox blnIsFound
        lngSafety = lngSafety + 1
        If lngSafety > 8 Then
            MsgBox lngSafety & " Durchgänge, vermutlich Endlosschleife"
            Exit Sub
        End If
        If blnIsFound Then
            CopyCurrentParagraph
            Selection.Collapse Direction:=wdCollapseStart
            Selection.PasteAndFormat (wdFormatOriginalFormatting)
            ReplaceTextInCurrentParagraph
        End If
    Wend
    MsgBox lngSafety & " Durchgänge"
    Err.Clear
Error:
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & vbLf & Err.Description: Err.Clear
End Sub

Sub CopyCurrentParagraph()
    Selection.StartOf Unit:=wdParagraph
    Selection.MoveEnd Unit:=wdParagraph
    Selection.Copy
End Sub

Sub ReplaceTextInCurrentParagraph()
    Selection.StartOf Unit:=wdParagraph
    Selection.MoveEnd Unit:=wdParagraph
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .TEXT = sTEXT
        .Replacement.TEXT = sREPLACETEXT
        .Forward = True
        .Wrap = wdFindStop
        .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
End Sub