Word VBA查找使用通配符

问题描述

我有一个单词表，它有2000行。每行包含一定范围，即从10平方尺开始的平方码土地面积（平方码）。码到70000平方码。我必须对其进行过滤，需要行数超过500 Sq的行。 Yds。在2000行中，我想使用VBA Word宏中的通配符来过滤这些行，这样我将得到500的范围，并且超过它，而使行低于500 Sq。 yds。找到的文本是字符和数字的组合。我想过滤查找“ 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

解决方法

代码中的注释表明您正在寻找“ 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

之前：

之后：