Замена символов через раз

Sub mac1()
Dim x
With Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = True
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.HomeKey Unit:=wdStory
For Each x In Split(UDAL)
    Selection.Find.Execute x, Replace:=wdReplaceAll
Next
Selection.Find.Execute "1", ReplaceWith:="2", Replace:=wdReplaceAll
End Sub

Sub mac1()
With Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "1"
    .Replacement.Text = "2"
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = True
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.HomeKey Unit:=wdStory
Do While Selection.Find.Execute(Replace:=wdReplaceOne) 'замена
  Selection.Collapse wdCollapseEnd
  Selection.Find.Execute                               'поиск без замены
  Selection.Collapse wdCollapseEnd
Loop
End Sub

Sub OddTextFilter()
Const s = "1" 'заменяемый символ (в нечётных позициях)
Const z = "2" 'заменяющий символ
Dim even As Boolean 'счётчик (датчик) чётности найденного s
 
With Selection
    .HomeKey wdStory 'перевод курсора в начало документа Word
    .Find.Text = s  'настройка диалога поиска/замены (который по CTRL h)
 
    
    Do While .Find.Execute(Replace:=wdReplaceNone) 'пока находим этот символ
        If Not even Then    'если он нечётный - заменяем на z
            .TypeText z     'впечатали z вместо найденного s
            .Collapse Direction:=wdCollapseEnd 'сброс выделения после очередной замены
        End If
        
        even = Not even 'расчёт на "первый-второй"
    Loop
    
End With
End Sub

Sub OddEvenTextFilter()
Const odd = -1  'а если сделать = 0 (False), заменит в чётных позициях
Const s = "1"   'заменяемый символ (в нечётных позициях)
Const z = "2"   'заменяющий символ
Dim even As Boolean 'счётчик (датчик) чётности найденного s
If Not odd Then even = Not even
 
With Selection
    .HomeKey wdStory 'перевод курсора в начало документа Word
    .Find.Text = s   'искомый текст
 
    
    Do While .Find.Execute(Replace:=wdReplaceNone) 'пока находим этот символ
        If Not even Then    'если он нечётный - заменяем на z
            .Range.HighlightColorIndex = wdYellow 'подсветка s
            .TypeText z     'впечатали z вместо найденного s
        End If
        
        even = Not even 'расчёт на "первый-второй"
    Loop
   
End With
End Sub

Sub MagicTextFilter()
Const n = 4     'кратность действия замен (натуральное число): 1-й, 5-й, 9-й…
Const s = "1"   'заменяемый текст
Const z = "2"   'заменяющий текст
Dim k As Long   'счётчик (датчик) кратности найденного s
 
    With Selection
        .HomeKey wdStory 'перевод курсора в начало документа Word
        .Find.Text = s   'искомый текст
        Do While .Find.Execute(Replace:=wdReplaceNone) 'пока есть s
            k = k + 1
            If k Mod n = 1 Then .TypeText z 'впечатали z вместо s
        Loop
    End With
End Sub