VBA: Замена каждого n конкретного символа в word с помощью макроса

[vivka]

Здравствуйте, Администратор!
Помогите, пожалуйста, попросить код заменять, например, каждый пятый ноль на единицу в selection!
Перепробовал всякие варианты, но без толку.

Макрос

Sub Test()

Dim i As Long, j As Long, rng As range
Set rng = selection.range

Application.ScreenUpdating = False

        With rng.Duplicate
          With .find
            .ClearFormatting
            .replacement.ClearFormatting
            .text = "0"
            .Format = True
            .Forward = True
            .Wrap = wdFindStop
            .MatchWildcards = True
            .Execute
          End With
          j = 0
            Do While .find.found
            j = j + 1
            If .InRange(rng) Then
              If j Mod 5 = 0 Then
                .find.replacement.text = "1"      'это не работает
                End If
              .Collapse wdCollapseEnd
              .find.Execute
            Else
            Exit Do
            End If
          Loop
        End With
   
    Application.ScreenUpdating = True

End Sub

[Администратор]

У меня свой шаблон для создания макросов по поиску, я его просто копирую в новый макрос и затем изменяю. Поэтому я не буду вникать в ваш макрос, к тому же в ворде могут быть какие-нибудь тонкости, поэтому лучше использовать одно и то же.

Этот макрос работает при условии, что нужно менять один символ на один. Если надо менять один символ на несколько, то нужно изменить макрос.

Макрос

Sub Макрос()
   
    Dim find_rng As Range, find As find, SelEnd As Long
    Dim counter As Long
   
   
    ' Откл. монитора (может это ускорит макрос).
    Application.ScreenUpdating = False
   
    '1. Запоминание конца выделения.
    SelEnd = Selection.Range.End
   
    '2. Создание объектов для поиска.
    Set find_rng = Selection.Range.Duplicate
    find_rng.Collapse Direction:=wdCollapseStart
    Set find = find_rng.find
   
    '3. Настройка поиска.
    find.Text = 0
    find.Wrap = wdFindStop
   
    '4. Поиск и замена.
    Do While find.Execute = True
   
        '1) Если найдено за пределами выделенного фрагмента.
        If find_rng.End > SelEnd Then
            Exit Do
        End If
       
        '2) Подсчёт найденных нулей.
        counter = counter + 1
       
        '3) Если это очередной пятый.
        If counter Mod 5 = 0 Then
            ' Замена нуля на 1.
            find_rng.Text = 1
        End If
       
        '4) Смещение невидимого курсора вправо от найденного фрагмента, чтобы поиск
            ' начался после найденного фрагмента, а не в найденном фрагменте.
        find_rng.Collapse Direction:=wdCollapseEnd
       
    Loop
   
    '5. Сообщение.
    Application.ScreenUpdating = True
    MsgBox "Готово.", vbInformation

End Sub

[vivka]

Администратор, спасибо большущее!
Как всегда, всё быстро, понятно и элегантно!
Феерично!!!