使用Excel VBA查找不符合4位数字/5位数字规则的单元格并复制到其他工作表

原有代码/逻辑的问题 #

• 变量SheetName未赋值，运行时会直接报错
• 高级筛选的通配符条件<>????/?????仅能匹配长度不符合的内容，无法校验/两侧是否为纯数字，会出现漏判、误判
• 通配符筛选无法实现完全匹配校验，会导致规则失效

方案1：VBA正则匹配实现（推荐） #

无需提前设置条件表，直接通过正则规则精准校验格式，不会出现误判，代码如下：

Sub GuaranteeElig()
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim regEx As Object
    Dim cell As Range
    Dim targetRow As Long
    
    ' 初始化正则对象，Late Binding无需提前引用库
    Set regEx = CreateObject("VBScript.RegExp")
    regEx.Pattern = "^\d{4}/\d{5}$" ' 4位数字/5位数字的完全匹配规则
    regEx.Global = False
    
    ' 定义源表、新建目标表
    Set wsSource = ThisWorkbook.Sheets("MainSheet")
    Set wsTarget = ThisWorkbook.Sheets.Add(After:=ActiveSheet)
    wsTarget.Name = "不符合项校验表" ' 可自行修改表名
    targetRow = 1 ' 目标表写入起始行
    
    ' 遍历源表所有已使用单元格
    For Each cell In wsSource.UsedRange
        ' 跳过空单元格
        If cell.Value <> "" Then
            ' 不符合规则就复制到目标表
            If Not regEx.Test(cell.Value) Then
                cell.Copy wsTarget.Cells(targetRow, 1)
                ' 如需保留原单元格位置信息，可取消下一行注释
                ' wsTarget.Cells(targetRow, 2) = "原位置：" & cell.Address
                targetRow = targetRow + 1
            End If
        End If
    Next
    
    ' 释放对象
    Set regEx = Nothing
    Set wsSource = Nothing
    Set wsTarget = Nothing
    
    MsgBox "校验完成，共找到" & targetRow - 1 & "条不符合项"
End Sub

方案2：修复高级筛选逻辑 #

如果要保留原有高级筛选的实现思路，按以下步骤修改即可：

1. 确认你需要校验的列在MainSheet中的列号，假设为A列、表头在A1
2. 在ConditionsSheet的B1单元格，填写和MainSheet校验列完全一致的表头
3. 在ConditionsSheet的B2单元格填写公式：

=NOT(AND(LEN(MainSheet!A2)=10,ISNUMBER(--LEFT(MainSheet!A2,4)),MID(MainSheet!A2,5,1)="/",ISNUMBER(--RIGHT(MainSheet!A2,5))))

4. 修复原有代码的变量问题，修改后代码如下：

Sub GuaranteeElig()
    Dim SheetName As String
    SheetName = "不符合项校验表"
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = SheetName
    Sheets("MainSheet").UsedRange.AdvancedFilter Action:= _
    xlFilterCopy, CriteriaRange:=Sheets("ConditionsSheet").Range("B1:B2"), _
    CopyToRange:=Range("A1"), Unique:=False
End Sub

注意：如果校验列不是A列，把公式里的MainSheet!A2改成对应列的第一行数据单元格即可。

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