Word VBA 使用通配符查找

Question

我有一个单词表，它有 2000 行。每行包含一些 EXTENT，即 10 Sq 的平方码（Sq. Yds）的土地面积。码到 70000 平方码。我必须过滤它，需要 Extent 超过 500 Sq 的行。码。在 2000 行中，我想使用 VBA Word 宏中的通配符过滤这些行，这样我将获得 500 和更多的 Extent，使行小于 500 Sq。码。要查找的文本是字符和数字的组合。我想过滤查找“EXTENT: ([5-9][0-9][0-9])”。 “EXTENT: XXXX”（数字）。

Sub FilterExtentUsingWildcards()
  Application.ScreenUpdating = False
  Dim TblRng As Range, TmpRng As Range
  With ActiveDocument.Tables(1)
    Set TblRng = .Range: Set TmpRng = .Range
    With .Range
      With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "<EXTENT:><space>([3-9][0-9][0-9])" 'FindText which is combination of
        'characters, space and Number
        .MatchWildcards = True                'i.e. "EXTENT: XXXX(number digits)
        .Replacement.Text = ""
        .Forward = True
        .Format = False
        .Wrap = wdFindStop
        .MatchCase = True
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute
      End With
      Do While .Find.Found
        If .InRange(TblRng) Then
          TmpRng.Collapse wdCollapseEnd
          TmpRng.FormattedText = .Rows(1).Range.FormattedText
          .Rows(1).Delete
        End If
        .Find.Execute
      Loop
    End With
    If .Rows.Count > TblRng.Rows.Count Then
      .Split .Rows(TblRng.Rows.Count + 1)
    End If
  End With
  Application.ScreenUpdating = True
End Sub

Answer 1

您的代码中的注释说您正在寻找“EXTENT: 300”及以上，但Find.Text 不包括空格。然后您打开 MatchWildcards 并在 7 行之后将其关闭。

我已将您的代码编辑如下：

Sub FilterExtentUsingWildcards()
  Application.ScreenUpdating = False
  Dim TblRng As Range, TmpRng As Range
  With ActiveDocument.Tables(1)
    Set TblRng = .Range: Set TmpRng = .Range
    With .Range
      With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .text = "EXTENT: ([5-9][0-9][0-9])" 'FindText which is combination of characters, space and Number
        .MatchWildcards = True 'i.e. "EXTENT: XXXX(number digits)
        .Replacement.text = ""
        .Forward = True
        .Format = False
        .Wrap = wdFindStop
        .MatchCase = True
        .MatchWholeWord = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute
      End With
      Do While .Find.Found
        If .InRange(TblRng) Then
          TmpRng.Collapse wdCollapseEnd
          TmpRng.FormattedText = .Rows(1).Range.FormattedText
          .Rows(1).Delete
        End If
        .Find.Execute
      Loop
    End With
    If .Rows.Count > TblRng.Rows.Count Then
      .Split .Rows(TblRng.Rows.Count + 1)
    End If
    'uncomment the next line if you want to delete the original table
    '.Delete
  End With
  Application.ScreenUpdating = True
End Sub

之前：

之后：