Здравствуйте, Администратор!
Помогите, пожалуйста, попросить код заменять, например, каждый пятый ноль на единицу в 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
Администратор, спасибо большущее!
Как всегда, всё быстро, понятно и элегантно!
Феерично!!!