时间戳

首页 > 解决方案 > MS Word VBA 在单词周围查找文本

vba - MS Word VBA 在单词周围查找文本

问题描述

我想在 Microsoft Word 中查找文本并获取相邻的单词。

我想从一个单词开始，然后找到围绕它的所有单词。

该函数应该是递归的。

例如：

abc def ghi jkl mno def pqr stu wxy def

如果我搜索字符串“def”，该函数应该返回我：

abc def ghi mno def pqr wxy def

这是可能的？

谢谢你！

Sub Cerca(Parola)

Dim rng1 As Range
Dim rng2 As Range
Dim rngFound As Range
Dim Prima As Integer
Dim Dopo As Integer

Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting

 With Selection.Find
     .Text = Parola
    ' .Replacement.Text = "Provo"
     .Forward = True
     .Wrap = wdFindStop
     Do While .Execute() = True

         Selection.MoveRight Unit:=wdWord, Count:=4
         Set rng2 = Selection.Range

         Selection.MoveLeft Unit:=wdWord, Count:=9
         Set rng1 = Selection.Range

         Prima = rng1.Start
         Dopo = rng2.Start


         Set rngFound = ActiveDocument.Range(Prima, Dopo)
         strTheText = rngFound.Text
         ScriviFile Parola & Chr(9) & strTheText
         'Selection.Find.Replacement.Font.Italic = True
         'Selection.Font.Bold = True
         'Selection.MoveRight Unit:=wdCharacter, Count:=Dopo
        ' Selection.MoveRight Unit:=wdWord, Count:=1
        Selection.MoveRight Unit:=wdWord, Count:=9

     Loop
 End With
End Sub

我发布的程序效果不佳，因为它还将标点符号视为单词。

我试图更好地解释自己......我想要一个函数，它可以在 Microsoft Word 文档中搜索一个字符串，并在我传递的字符串之前和之后给我一个单词“x”。例如....

function myGetMyListOfSearch(SearchString as string, PreviusWord as integer, NextWord as integer)

这个函数返回一个“字符串”列表，其中我的“SearchString”被它左右两边的术语包围......

这是可能的？

标签： vbams-wordfind

解决方案

I am not proud of this solution ....

I look for a string in a word document and publish the result in a table of another word document ... The table is divided into 3 parts: in the center the string I searched for, in the first column "x number of words" to the left of the string and in the third column "y number of words" to the right of the searched string. But it's very slow ... better solutions? Thank you

Sub Cerca(Parola, Destinazione)

Dim rng1 As Range
Dim rng2 As Range
Dim rngFound As Range
Dim Prima As Long
Dim Dopo As Long
Dim PosizioneAttuale As Long
Dim strSinistra As String
Dim strCentro As String
Dim strDestra As String
Dim UltimaRiga As Long
Dim Ciclo As Long
Dim Sicurezza As Long

Selection.HomeKey Unit:=wdStory
'Selection.Find.ClearFormatting

 With Selection.Find
     .Text = Parola
    ' .Replacement.Text = "Provo"
     .Forward = True
     .Wrap = wdFindStop
     .IgnorePunct = True
     .MatchWholeWord = ParoleIntere
     .ClearFormatting
     .Format = False
     Do While .Execute() = True

         DoEvents

         PosizioneAttuale = Selection.Start


         'SI CONTROLLA A DESTRA
         Ciclo = 0
         Sicurezza = 0
         Do
            'DoEvents
            Sicurezza = Sicurezza + 1
            Selection.MoveRight Unit:=wdWord, Count:=1
            If InStr(1, ".,;:-_/!\'()" & Chr(34) & vbCrLf, Trim(Selection.Range.Words.Item(1)), vbTextCompare) = 0 Then
                Ciclo = Ciclo + 1
            End If
            If Sicurezza > 100 Then
                'Debug.Print "esco con exit do"
                'Selection.MoveLeft Unit:=wdWord, Count:=501
                Exit Do 'nel caso entri in loop per qualche motivo
            End If
         Loop Until Ciclo = ParoleDopo Or Selection.Range.Start = ActiveDocument.Range.End

         Selection.MoveRight Unit:=wdWord, Count:=1
         Set rng2 = Selection.Range

         Selection.Start = PosizioneAttuale


         'SI CONTROLLA A SINISTRA

         Ciclo = 0
         Sicurezza = 0
         Selection.MoveLeft Unit:=wdWord, Count:=1
         Do
            'DoEvents
            Sicurezza = Sicurezza + 1
            Selection.MoveLeft Unit:=wdWord, Count:=1
            If InStr(1, ".,;:-_/!\'()", Trim(Selection.Range.Words.Item(1)), vbTextCompare) = 0 Then
                Ciclo = Ciclo + 1
            End If
            If Sicurezza > 100 Then
                Debug.Print "esco con exit do"
                'Selection.MoveRight Unit:=wdWord, Count:=501
                Exit Do 'nel caso entri in loop per qualche motivo
            End If
         Loop Until Ciclo = ParolePrima Or Selection.Range.Start = ActiveDocument.Range.End



         'Selection.MoveLeft Unit:=wdWord, Count:=ParolePrima + 1
         Set rng1 = Selection.Range

         Prima = rng1.Start
         Dopo = rng2.Start

         If Dopo > Prima Then
                 Set rngFound = ActiveDocument.Range(Prima, Dopo)

                 strTheText = rngFound.Text



                 'ScriviFile Left(strTheText, Prima) & Chr(9) & Parola & Chr(9) & Mid(strTheText, Dopo)
                 strSinistra = Left(strTheText, PosizioneAttuale - Prima)
                 strCentro = Parola
                 Prima = PosizioneAttuale + Len(Parola)
                 If Prima = -1 Then Prima = 0
                 strDestra = Right(strTheText, Dopo - Prima)


                 Selection.Start = PosizioneAttuale
                 Selection.MoveRight Unit:=wdWord, Count:=1

                 'scrivo nella tabella del foglio destinazione
                  Documents(Destinazione).Tables(1).Rows.Add
                  UltimaRiga = Documents(Destinazione).Tables(1).Rows.Count
                      Documents(Destinazione).Tables(1).Cell(UltimaRiga, 1).Range.InsertAfter strSinistra
                      Documents(Destinazione).Tables(1).Cell(UltimaRiga, 2).Range.InsertAfter strCentro
                      Documents(Destinazione).Tables(1).Cell(UltimaRiga, 3).Range.InsertAfter strDestra



         End If

     Loop
 End With
End Sub

推荐阅读