excel - 检测 Word VBA 中包含 '-' 的单词

Question

我正在使用这段代码遍历文档中的所有单词，并找出其中是否包含所述字符串并将它们复制到另一个文件，但单词似乎会在中间剪切单词以防万一'-' 特点。示例

        For Each sentence In x.StoryRanges
        For Each w In sentence.Words
            If InStr(1, w, "asdf") = 1 Then
               objDoc.worksheets(1).Cells(i, 1).Value = w
  -continue code

它只捕捉并复制单词“asdfaq-123”作为“asdfaq”，有没有办法复制直到它点击“。”或 ' '(空格)或 ')' 、 ']' 等。

谢谢!

Answer 1

根据下面的代码尝试一些操作，它使用通配符 Find 来定位感兴趣的字符串。

从表面上看，人们希望能够像您显然正在尝试做的那样简单地遍历文档的 StoryRanges。然而，StoryRanges 对象不能可靠地与页眉、页脚和形状的查找/替换一起工作——在具有多个页眉、页脚和形状成员的 StoryRange 上查找/替换似乎只查看第一个成员。因此，代码中出现了明显的迂回。

Dim r As Long

Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range, Sctn As Section, Shp As Shape, HdFt As HeaderFooter
With ActiveDocument
  For Each Rng In .StoryRanges
    Call FndRep(Rng)
    For Each Shp In Rng.ShapeRange
      With Shp
        If Not .TextFrame Is Nothing Then
          Call FndRep(.TextFrame.TextRange)
        End If
      End With
    Next
  Next
  For Each Sctn In .Sections
    For Each HdFt In Sctn.Headers
      With HdFt
        If .Exists = True Then
          If .LinkToPrevious = False Then
            Call FndRep(HdFt.Range)
            For Each Shp In HdFt.Shapes
              With Shp
                If Not .TextFrame Is Nothing Then
                  Call FndRep(.TextFrame.TextRange)
                End If
              End With
            Next
          End If
        End If
      End With
    Next
    For Each HdFt In Sctn.Footers
      With HdFt
        If .Exists = True Then
          If .LinkToPrevious = False Then
            Call FndRep(HdFt.Range)
            For Each Shp In HdFt.Shapes
              With Shp
                If Not .TextFrame Is Nothing Then
                  Call FndRep(.TextFrame.TextRange)
                End If
              End With
            Next
          End If
        End If
      End With
    Next
  Next
End With
Application.ScreenUpdating = True
End Sub

Sub FndRep(Rng As Range)
With Rng
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "<asdf*>"
    .Replacement.Text = ""
    .Format = False
    .Forward = True
    .Wrap = wdFindStop
    .MatchWildcards = True
  End With
  Do While .Find.Execute
    If .Characters.Last.Next = "-" Then .MoveEnd wdWord, 2
    r = r + 1
    objDoc.worksheets(1).Cells(r, 1).Value = .Text
    .Collapse wdCollapseEnd
  Loop
End With
End Sub