检测 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”，有没有办法复制直到它点击“。”或 ' '(space) 或 ')' , ']' 等..

谢谢！

Answer 1

这是你正在尝试的吗？

设置对 Microsoft VBScript Regualr Expressions x.x 库的引用

Option Explicit

Sub Sample()
    Dim myRegExp As RegExp
    Dim myMatches As MatchCollection
    Dim myMatch As Match

    Set myRegExp = New RegExp

    With myRegExp
        .Global = True
        .Pattern = "([a-zA-Z0-9]+-[a-zA-Z0-9]+)"

        Set myMatches = myRegExp.Execute(ActiveDocument.Range.Text)

        For Each myMatch In myMatches
            Debug.Print myMatch.Value
        Next
    End With
End Sub

解释：

([a-zA-Z0-9]+-[a-zA-Z0-9]+)

(...)        - Isolate Full match
[a-zA-Z]     - Matches any characters between (Including) a-z or A-Z. 
[0-9]        - Matches any characters between (Including) 0 or 9. 
+ Quantifier - Matches between one and unlimited times

进行中：

提示：

我通常使用 Online regex tester 来测试我的正则表达式模式。

Answer 2

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

从表面上看，人们会期望能够像您显然试图做的那样简单地遍历文档的 StoryRanges。但是，StoryRanges 对象不能可靠地与 Find/Replace 一起用于页眉、页脚和形状 - Find/Replace 在具有多个页眉、页脚和形状成员的 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

Answer 3

我最终用临时字符串替换了“-”，这样 Word 会将其检测为单个单词，在复制单词后，我将临时字符串替换回“-”。

        With x.Content.Find ' replaces '-'s with "rplcmltr"
        .ClearFormatting
        .Text = "-"
        .Replacement.ClearFormatting
        .Replacement.Text = "rplcmltr"
        .Execute Replace:=wdReplaceAll, Forward:=True, _
        Wrap:=wdFindContinue
    End With

检测 Word VBA 中包含“-”的单词

Detect words in Word VBA that contain '-' in them

excel

vba

ms-word