Как найти и заменить? - PullRequest
0 голосов
/ 05 ноября 2018

У меня есть этот код, и мне интересно, может ли он быть короче?

Я новичок в VBA и начинаю с Macro Recorder. Функция «Найти и заменить». Я знаю, что для этого должен быть короткий код.

Sub TOs()
    '
    ' MACRO_TOS Macro    
    '    
    '
    Selection.Find.ClearFormatting    
    Selection.Find.Replacement.ClearFormatting    

    With Selection.Find
        .Text = "To=____________________________"   
        .Replacement.Text = ""    
        .Forward = True    
        .Wrap = wdFindContinue    
        .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

Ответы [ 2 ]

0 голосов
/ 11 ноября 2018

Ни один из MatchCase, MatchWholeWord, MatchAllWordForms и MatchSoundsLike не работает с подстановочными знаками. Соответственно, код может быть уменьшен до:

Sub RemoveTo()
With Selection.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Text = "To[ =]@[_]{1,}"
  .Replacement.Text = ""
  .Forward = True
  .Format = False
  .Wrap = wdFindContinue
  .MatchWildcards = True
  .Execute Replace:=wdReplaceAll
End With
End Sub

или даже:

Sub RemoveTo()
With Selection.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Execute FindText:="To[ =]@[_]{1,}", ReplaceWith:="", MatchWildcards:=True, _
    Forward:=True, Format:=False, Wrap:=wdFindContinue, Replace:=wdReplaceAll
End With
End Sub
0 голосов
/ 05 ноября 2018
  1. Вы можете использовать Replace:=wdReplaceAll, чтобы заменить все сразу.
  2. Вы можете использовать .MatchWildcards = True, чтобы разрешить использование подстановочных знаков в .Text, где могут быть пробелы. Например: .Text = "To*=*____________________________"

Пример:

Option Explicit

Sub RemoveTo()
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "To=____________________________"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With

    Selection.Find.Execute Replace:=wdReplaceAll 'replaceAll
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...