Question

我想在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”用它的左右两侧的术语包围着。

有可能吗？

Answer 1

通配符查找方式：

查找= <[！ ] @> [,. ^ t ^ l ^ 13] @Parola [,. ^ t ^ l ^ 13] @ <[！ ] @>

就足够了，即使前一个/下一个单词在不同的段落中。

Answer 2

我不为这个解决方案感到骄傲....

我在单词文档中寻找一个字符串，并将结果发布到另一个单词文档的表中... 该表分为3部分：在中心，我搜索的字符串，在该字符串左侧的第一列“ x字数”，在搜索的右侧第三列“ y字数”串。但这很慢...更好的解决方案？谢谢

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

MS Word VBA查找单词周围的文本

2 个答案: