Макросы Word VBA — поиск, поиск и замена

Содержание
  1. Word VBA Find Этот пример представляет собой простой макрос слова для поиска текста «a»: Sub SimpleFind () Selection.Find.ClearFormatting With Selection.Find .Text = "a" .Replacement.Text = "" .Forward = True .Wrap = wdFindAsk .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWord EndForms = False Selection.Find.ExecuteEnd Sub Найти и заменить Этот простой макрос будет искать слово «их» и заменять его на «там»: Sub SimpleReplace () Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "their" .Replacement.Text = "there" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace: = wdReplaceAllEnd Sub Найти и заменить только в Sel ection Этот макрос VBA найдет и заменит текст в выделенном фрагменте. Он также будет выделять замененный текст курсивом. Sub ReplaceInSelection () 'заменяет текст ТОЛЬКО в выделении. кроме того, замененный текст выделяется курсивом Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "their" With .Replacement .Font.Italic = True .Text = "there" End With .Forward = True .Wrap = wdFindStop 'это предотвращает продолжение Word до конца документа .Format = True' мы также хотим заменить форматирование текста .MatchCase = False .MatchWholeWord = True .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End С Selection.Find.Execute Replace: = wdReplaceAllEnd Sub Эта строка кода предотвращает продолжение VBA до конца документа Word: .Wrap = wdFindStop ' это предотвращает продолжение Word до конца документа Эта строка кода указывает также на замену форматирования текста: .Format = True 'мы хотим для замены форматирования текста также Найти и заменить только в диапазоне Вместо замены текста во всем документе, или в selection, мы можем указать VBA найти и заменить только в диапазоне. В этом примере мы определили диапазон как первый абзац: Dim oRange As RangeSet oRange = ActiveDocument.Paragraphs (1) .Range Sub ReplaceInRange () 'заменяет текст ТОЛЬКО в диапазоне [в этом примере только в первом абзаце] Dim oRange As RangeSet oRange = ActiveDocument.Paragraphs (1) .Range oRange.Find.ClearFormatting oRange.Find.Replacement.ClearFormatting With oRange.Find .Text = "their" .Replacement.Text = "there" .Forward = True .Wrap = wdFindStop 'это предотвращает продолжение Word до конца документа .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False. MatchAllWordForms = False End With oRange.Find.Execute Replace: = wdReplaceAllEnd Sub VBA поменять местами слова в строке В VBA я создал пользовательскую форму. Он содержит несколько текстовых полей, в которых пользователь может писать текст. В одном текстовом поле пользователь должен ввести свою фамилию. Я создал переменную с именем lastname, а затем сделал lastname = LastnameBox.Value. Мой вопрос: Если кто-то, например, набирает de Vries, как я могу изменить это в Vries, de код>. Или, если кто-то набирает van de Voort van Zijp, мне нужно изменить это в Voort van Zijp, van de. Как я могу сделать это возможным в VBA? Я бы попробовал что-нибудь в этом роде. Не уверен, как вам требуется разделение, я использовал «de» в качестве этой Function NamesTest (strNameIn As String) Dim a () As Stringa = Split (strNameIn, "de" ) a (0) = a (0) & "de" NamesTest = a (1) & "," & a (0) Конечная функция Вот два варианта. Первый возьмет последнее слово и произведет обмен. Не обращает внимания на регистр букв. Sub LastFirst () Debug.Print RevLast ("de Vries") Debug.Print RevLast ("van der Straat") Debug.Print RevLast ("van de drake") End SubFunction RevLast (Name) LastName = Trim (Right (Replace (Name, "", String (99, "")), 99)) LenLastName = Len (LastName) FirstPart = Left (Name , Len (Name) - (LenLastName + 1)) RevLast = LastName + "," + FirstPartEnd Function Второй заменяет только заглавную букву. Sub UppercaseFirst () Name = "de Vries" Name = "van der Straat" Debug.Print RevUpper ("de Vries") Debug.Print RevUpper ("van der Straat") Отладка. Печать RevUpper ("van de drake") Конечная подфункция RevUpper (Name) FirstUpper = -1 При ошибке Продолжить Далее xStr = Trim (Rg.Value) Для j = Len (Name) To 1 Step -1 If (Asc (Mid (Name) , j, 1)) 64) Then FirstUpper = Len (Name) - j + 1 Exit For End If Next If FirstUpper> 0 Then LastName = Right ( Имя, FirstUpper) FirstPart = Left (Name, Len (Имя) - (Fi rstUpper + 1)) NewName = LastName + "," + FirstPart RevUpper = NewName Else RevUpper = "Invalid" End IfEnd FunctionFunction RevNm (Name) FirstUpper = -1 При ошибке Возобновить следующий xStr = Trim (Rg. Значение) Для j = Len (Name) To 1 Step -1 If (Asc (Mid (Name, j, 1)) 64) Then FirstUpper = Len (Name) - j + 1 Exit For End If Next If FirstUpper> 0 Then LastName = Right (Name, FirstUpper) FirstPart = Left (Name, Len (Name) - (FirstUpper + 1)) NewName = LastName + "," + FirstPart RevNm = NewName Else RevNm = "Invalid" End IfEnd Function 1 Вот более универсальное решение проблемы, указанной в заголовке (не обрабатывает особенности инвертирования имени/фамилии, что является другой проблемой): Открытая функция ReverseWords (значение ByVal в виде строки) в виде строки Тусклые слова в виде Variant words = VBA.Strings.Split (значение, "") Dim result As String, i As Long For i = LBound (words) To UBound (слова) result = words (i) & "" & result Next ReverseWords = resultEnd Function Использование: Debug.Print ReverseWords («быстрая коричневая лиса перепрыгивает через ленивую собаку») Выводит: собака лениво прыгает лиса коричневый быстро Однако в OP речь не идет о инвертировании слова в строке вообще. Решение состоит в том, чтобы проанализировать данную строку. Первая заглавная буква действительно там, где я хочу поменять местами Итак, вам нужно найти индекс первой заглавной буквы во входной строке, затем извлечь имя и фамилию, обрезать их, а затем объединить. Это работает: Открытая функция ReverseFullName (значение ByVal как строка) Как строка Dim firstCapitalIndex As Long, i As Long For i = 1 To Len (value ) If IsCapitalLetter (Mid $ (value, i, 1)) Then firstCapitalIndex = i Exit For End If Next If i = 1 Then 'уже сформирован по мере необходимости ReverseFullName = value Exit Function End If Dim firstName As String firstName = Trim $ (Left $ (value, firstCapitalIndex - 1)) Dim lastName As String lastName = Trim $ (Mid $ (value, firstCapitalIndex)) ReverseFullName = lastName & "," & firstNameEnd FunctionPrivate Function IsCapitalLetter (ByVal value as String) As Boolean Dim Integer asciiCode As Boolean Dim Integer asciiCode As Boolean Dim Integer asciiCode As Boolean Dim Integer asciiCode As Boolean Dim Integer asciiCode asciiCode = Asc (значение) IsCapitalLetter = asciiC ode> = Asc ("A") и asciiCode Использование: Debug.Print ReverseFullName ("van de Voort van Zijp") Debug.Print ReverseFullName ("de Vries") Debug.Print ReverseFullName ("Voort van Zijp, van de") Выходы: Ворт ван Зиджп, ван де Врис, деВорт ван Зиджп, ван де
  2. Найти и заменить
  3. Найти и заменить только в Sel ection
  4. VBA поменять местами слова в строке

Word VBA Find

Этот пример представляет собой простой макрос слова для поиска текста «a»:

 Sub SimpleFind () Selection.Find.ClearFormatting With  Selection.Find .Text = "a" .Replacement.Text = "" .Forward = True .Wrap = wdFindAsk .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWord EndForms = False  Selection.Find.ExecuteEnd Sub 

Найти и заменить

Этот простой макрос будет искать слово «их» и заменять его на «там»:

 Sub SimpleReplace () Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "their" .Replacement.Text = "there" .Forward = True .Wrap = wdFindContinue .Format =  False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace: = wdReplaceAllEnd Sub 

Найти и заменить только в Sel ection

Этот макрос VBA найдет и заменит текст в выделенном фрагменте. Он также будет выделять замененный текст курсивом.

 Sub ReplaceInSelection () 'заменяет текст ТОЛЬКО в выделении.  кроме того, замененный текст выделяется курсивом Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "their" With .Replacement .Font.Italic = True .Text = "there" End With .Forward = True  .Wrap = wdFindStop 'это предотвращает продолжение Word до конца документа .Format = True' мы также хотим заменить форматирование текста .MatchCase = False .MatchWholeWord = True .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End  С Selection.Find.Execute Replace: = wdReplaceAllEnd Sub 

Эта строка кода предотвращает продолжение VBA до конца документа Word:

 .Wrap = wdFindStop '  это предотвращает продолжение Word до конца документа 

Эта строка кода указывает также на замену форматирования текста:

 .Format = True 'мы хотим  для замены форматирования текста также 

Найти и заменить только в диапазоне

Вместо замены текста во всем документе, или в selection, мы можем указать VBA найти и заменить только в диапазоне. В этом примере мы определили диапазон как первый абзац:

 Dim oRange As RangeSet oRange = ActiveDocument.Paragraphs (1) .Range 

 Sub ReplaceInRange () 'заменяет текст ТОЛЬКО в диапазоне [в этом примере только в первом абзаце] Dim oRange As RangeSet oRange = ActiveDocument.Paragraphs (1) .Range oRange.Find.ClearFormatting oRange.Find.Replacement.ClearFormatting With  oRange.Find .Text = "their" .Replacement.Text = "there" .Forward = True .Wrap = wdFindStop 'это предотвращает продолжение Word до конца документа .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards  = False .MatchSoundsLike = False. MatchAllWordForms = False End With oRange.Find.Execute Replace: = wdReplaceAllEnd Sub 



VBA поменять местами слова в строке

В VBA я создал пользовательскую форму. Он содержит несколько текстовых полей, в которых пользователь может писать текст. В одном текстовом поле пользователь должен ввести свою фамилию. Я создал переменную с именем lastname , а затем сделал lastname = LastnameBox.Value .

Мой вопрос:
Если кто-то, например, набирает de Vries , как я могу изменить это в Vries, de код>. Или, если кто-то набирает van de Voort van Zijp , мне нужно изменить это в Voort van Zijp, van de .

Как я могу сделать это возможным в VBA?


Я бы попробовал что-нибудь в этом роде. Не уверен, как вам требуется разделение, я использовал «de» в качестве этой

  Function NamesTest (strNameIn As String) Dim a () As Stringa = Split (strNameIn, "de"  ) a (0) = a (0) & "de" NamesTest = a (1) & "," & a (0) Конечная функция  

Вот два варианта. Первый возьмет последнее слово и произведет обмен. Не обращает внимания на регистр букв.

  Sub LastFirst () Debug.Print RevLast ("de Vries") Debug.Print RevLast ("van der Straat") Debug.Print  RevLast ("van de drake") End SubFunction RevLast (Name) LastName = Trim (Right (Replace (Name, "", String (99, "")), 99)) LenLastName = Len (LastName) FirstPart = Left (Name  , Len (Name) - (LenLastName + 1)) RevLast = LastName + "," + FirstPartEnd Function  

Второй заменяет только заглавную букву.

  Sub UppercaseFirst () Name = "de Vries" Name = "van der Straat" Debug.Print RevUpper ("de Vries") Debug.Print RevUpper ("van der Straat") Отладка.  Печать RevUpper ("van de drake") Конечная подфункция RevUpper (Name) FirstUpper = -1 При ошибке Продолжить Далее xStr = Trim (Rg.Value) Для j = Len (Name) To 1 Step -1 If (Asc (Mid (Name)  , j, 1))  64) Then FirstUpper = Len (Name) - j + 1 Exit For End If Next If FirstUpper> 0 Then LastName = Right (  Имя, FirstUpper) FirstPart = Left (Name, Len (Имя) - (Fi  rstUpper + 1)) NewName = LastName + "," + FirstPart RevUpper = NewName Else RevUpper = "Invalid" End IfEnd FunctionFunction RevNm (Name) FirstUpper = -1 При ошибке Возобновить следующий xStr = Trim (Rg. Значение) Для j = Len (Name) To 1 Step -1 If (Asc (Mid (Name, j, 1))  64) Then FirstUpper = Len  (Name) - j + 1 Exit For End If Next If FirstUpper> 0 Then LastName = Right (Name, FirstUpper) FirstPart = Left (Name, Len (Name) - (FirstUpper + 1)) NewName = LastName + "," +  FirstPart RevNm = NewName Else RevNm = "Invalid" End IfEnd Function  

1


Вот более универсальное решение проблемы, указанной в заголовке (не обрабатывает особенности инвертирования имени/фамилии, что является другой проблемой):

   Открытая функция ReverseWords (значение ByVal в виде строки) в виде строки Тусклые слова в виде Variant words = VBA.Strings.Split (значение, "") Dim result As String, i As Long For i = LBound (words) To UBound  (слова) result = words (i) & "" & result Next ReverseWords = resultEnd Function  

Использование:

  Debug.Print ReverseWords («быстрая коричневая лиса перепрыгивает через ленивую собаку»)  

Выводит:

  собака лениво прыгает лиса коричневый быстро 

Однако в OP речь не идет о инвертировании слова в строке вообще. Решение состоит в том, чтобы проанализировать данную строку.

Первая заглавная буква действительно там, где я хочу поменять местами

Итак, вам нужно найти индекс первой заглавной буквы во входной строке, затем извлечь имя и фамилию, обрезать их, а затем объединить.

Это работает:

  Открытая функция ReverseFullName (значение ByVal как строка) Как строка Dim firstCapitalIndex As Long, i As Long For i = 1 To Len (value  ) If IsCapitalLetter (Mid $ (value, i, 1)) Then firstCapitalIndex = i Exit For End If Next If i = 1 Then 'уже сформирован по мере необходимости ReverseFullName = value Exit Function End If Dim firstName As String firstName = Trim $ (Left  $ (value, firstCapitalIndex - 1)) Dim lastName As String lastName = Trim $ (Mid $ (value, firstCapitalIndex)) ReverseFullName = lastName & "," & firstNameEnd FunctionPrivate Function IsCapitalLetter (ByVal value as String) As Boolean Dim Integer asciiCode As Boolean Dim Integer asciiCode As Boolean Dim Integer asciiCode As Boolean Dim Integer asciiCode As Boolean Dim Integer asciiCode  asciiCode = Asc (значение) IsCapitalLetter = asciiC  ode> = Asc ("A") и asciiCode  

Использование:

   Debug.Print ReverseFullName ("van de Voort van Zijp") Debug.Print ReverseFullName ("de Vries") Debug.Print ReverseFullName ("Voort van Zijp, van de")  

Выходы:

  Ворт ван Зиджп, ван де Врис, деВорт ван Зиджп, ван де  

Оцените статью
clickpad.ru
Добавить комментарий