使用Word VBA通配符筛选表格中EXTENT≥500平方码的行

看了你提供的代码，发现几个关键问题导致它没法正常工作：

1. 通配符设置自相矛盾：先开启.MatchWildcards = True，紧接着又设为False，等于完全没启用通配符功能
2. 查找表达式不符合需求：原表达式<EXTENT:><space>([3-9][0-9][0-9])不仅语法错误（Word通配符里空格直接输入就行，不用<space>），而且只能匹配300-999的数值，和你要的≥500不符
3. 逻辑搞反了：当前代码是删除找到的行，但你需要的是保留EXTENT≥500的行，逻辑得调整

下面是修正后的完整VBA代码，完全通过通配符实现你的需求，还做了性能优化：

Sub FilterExtentUsingWildcards()
    Application.ScreenUpdating = False
    Dim sourceTable As Table
    Dim targetTable As Table
    Dim currentCell As Range
    Dim matchPattern As String
    
    ' 定义通配符匹配规则：精准匹配EXTENT: 后跟≥500的数字
    ' 规则拆解：
    ' - EXTENT:  是固定前缀（注意后面的空格）
    ' - ([5-9][0-9]{2,}) 匹配500及以上的数字：5-9开头+至少2位数字（覆盖500-999、1000+）
    ' - [!0-9] 确保数字后面非数字，避免误匹配长数字的前三位（比如5000里的500）
    matchPattern = "EXTENT: ([5-9][0-9]{2,})[!0-9]"
    
    Set sourceTable = ActiveDocument.Tables(1)
    ' 在文档末尾新建表格存筛选结果（不破坏原数据）
    ActiveDocument.Content.InsertAfter vbCr
    Set targetTable = ActiveDocument.Tables.Add( _
        Range:=ActiveDocument.Content.Paragraphs.Last.Range, _
        NumRows:=1, NumColumns:=sourceTable.Columns.Count)
    ' 复制原表头到新表格
    sourceTable.Rows(1).Range.Copy
    targetTable.Rows(1).Range.Paste
    
    ' 遍历原表格每一行（跳过表头）
    For Each currentCell In sourceTable.Columns(1).Cells ' 假设EXTENT在第1列，按需改列号
        If currentCell.RowIndex > 1 Then
            With currentCell.Range.Find
                .ClearFormatting
                .MatchWildcards = True
                .Text = matchPattern
                .Forward = True
                .Wrap = wdFindStop
                .MatchCase = False ' 不区分大小写，可根据需求调整
                
                If .Execute Then
                    ' 匹配成功，复制该行到新表格
                    sourceTable.Rows(currentCell.RowIndex).Range.Copy
                    targetTable.Rows.Add
                    targetTable.Rows(targetTable.Rows.Count).Range.Paste
                End If
            End With
        End If
    Next currentCell
    
    ' 如果你想直接在原表格删除不符合条件的行，替换上面的新建表格逻辑为下面这段：
    ' Dim rowIndex As Long
    ' For rowIndex = sourceTable.Rows.Count To 2 Step -1
    '     With sourceTable.Rows(rowIndex).Cells(1).Range.Find
    '         .ClearFormatting
    '         .MatchWildcards = True
    '         .Text = matchPattern
    '         .Forward = True
    '         .Wrap = wdFindStop
    '         .MatchCase = False
    '         If Not .Execute Then
    '             sourceTable.Rows(rowIndex).Delete ' 删除不满足条件的行
    '         End If
    '     End With
    ' Next rowIndex
    
    Application.ScreenUpdating = True
    MsgBox "筛选完成！", vbInformation
End Sub

重要提示： #

• 列位置调整：代码默认EXTENT字段在第1列，如果实际在其他列，把Columns(1)改成对应的列号（比如第3列就写Columns(3)）
• 两种使用方式：
  • 新建表格存结果：适合需要保留原始数据的场景，不会改动原表格
  • 删除原表不符合的行：直接在原表格中保留符合要求的行，适合不需要备份原始数据的情况
• 通配符逻辑：[5-9][0-9]{2,}确保匹配所有≥500的整数，不管是3位还是更多位（比如70000也能匹配到）
• 性能优化：关闭ScreenUpdating能大幅提升2000行表格的处理速度，避免屏幕频繁闪烁

记得运行宏前先备份文档，防止意外数据丢失！

内容的提问来源于stack exchange，提问作者Sampath