Word VBA 使用通配符查找

Word VBA Find Using Wildcards

我有一个词 table,它有 2000 行。每行包含一些 EXTENT,即 10 平方码(平方码)的土地面积。码到 70000 平方码。我必须对其进行过滤,需要 Extent 超过 500 Sq 的行。码。在 2000 行中,我想使用 VBA Word 宏中的通配符过滤这些行,这样我将获得 500 的范围,并且超过 500 平方米的行。码。要查找的文本是字符和数字的组合。我想过滤查找“范围:([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

您代码中的注释说您正在寻找“EXTENT: 300”及以上,但 Find.Text 不包括 space。然后您打开 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

之前:

之后: