VBA宏开发求助：自动删除含PEDS+可变数字的整行

没问题，我来帮你调整代码，实现自动删除所有单元格值为PEDS开头且后续全为数字（比如PEDS1234）的整行。原代码的局限是只能匹配固定字符串，我们改用正则表达式来精准匹配你需要的模式，同时优化了执行效率。

修改后的完整代码 #

Option Explicit

Sub KillRows()
    Dim MyRange As Range, DelRange As Range, C As Range
    Dim SearchColumn As String, ActiveColumn As String
    Dim AC
    Dim regEx As Object '正则表达式对象
    
    ' 初始化正则，匹配"PEDS开头+一串数字"的模式
    Set regEx = CreateObject("VBScript.RegExp")
    regEx.Pattern = "^PEDS\d+$"
    regEx.IgnoreCase = False ' 如果不需要区分大小写，改成True即可
    
    ' 获取当前活动列作为默认搜索列
    AC = Split(ActiveCell.EntireColumn.Address(, False), ":")
    ActiveColumn = AC(0)
    
    ' 让用户选择要搜索的列
    SearchColumn = InputBox("Enter Search Column - press Cancel to exit sub", "Row Delete Code", ActiveColumn)
    On Error Resume Next
    Set MyRange = Columns(SearchColumn)
    On Error GoTo 0
    
    ' 若输入的列无效，直接退出
    If MyRange Is Nothing Then Exit Sub
    
    Application.ScreenUpdating = False ' 关闭屏幕刷新，提升速度
    
    ' 只遍历有文本内容的单元格，跳过空值和数值单元格
    For Each C In MyRange.SpecialCells(xlCellTypeConstants, xlTextValues)
        ' 检查单元格值是否符合PEDS+数字的模式
        If regEx.Test(C.Value) Then
            ' 收集所有匹配的单元格
            If DelRange Is Nothing Then
                Set DelRange = C
            Else
                Set DelRange = Union(DelRange, C)
            End If
        End If
    Next C
    
    ' 删除所有匹配的行（一次性删除，避免逐行删除的性能问题）
    If Not DelRange Is Nothing Then
        DelRange.EntireRow.Delete
        MsgBox "已成功删除所有符合条件的行！", vbInformation
    Else
        MsgBox "未找到任何匹配PEDS+数字模式的行。", vbInformation
    End If
    
    Application.ScreenUpdating = True ' 恢复屏幕刷新
    Set regEx = Nothing ' 释放正则对象
End Sub

关键修改说明 #

• 正则表达式匹配：用^PEDS\d+$精准定位目标字符串：
  • ^ 确保字符串以PEDS开头
  • \d+ 匹配一个或多个数字
  • $ 确保字符串结尾是数字（避免匹配PEDS123abc这类不符合需求的内容）
• 效率优化：通过SpecialCells只遍历文本类型的非空单元格，减少不必要的循环
• 批量删除：先收集所有需要删除的单元格，最后一次性删除整行，避免逐行删除时的行号错乱问题
• 移除冗余输入：因为我们的匹配模式是固定的（PEDS+数字），所以去掉了原代码中输入匹配字符串的步骤

如果你的需求是允许PEDS后面紧跟数字后还有其他字符（比如PEDS123abc），只需把正则模式改成^PEDS\d.*即可。

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