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
之前:
之后:
我有一个词 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
之前:
之后: