VBA循环筛选列、校验列并删除行功能实现咨询

核心逻辑 #

• 提取所有非空且唯一的「Customer Number」
• 逐个遍历每个客户编号：
  1. 筛选出该客户的所有行
  2. 校验「Months Pay」列是否存在0-4之间的值，存在则删除该客户所有行
  3. 若第一步不满足，校验「Own」列是否存在1-5之间的值，存在则删除该客户所有行

完整代码 #

Sub ProcessCustomers()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim customerCol As Integer, monthsPayCol As Integer, ownCol As Integer
    Dim uniqueCustomers As Object
    Dim cust As Variant
    Dim hasInvalidMonths As Boolean, hasInvalidOwn As Boolean
    
    ' 设置工作表和对应列号（根据实际表格调整）
    Set ws = ThisWorkbook.Worksheets("Sheet1") ' 替换为你的工作表名
    customerCol = 1 ' Customer Number在A列
    monthsPayCol = 2 ' Months Pay在B列
    ownCol = 3 ' Own在C列
    
    lastRow = ws.Cells(ws.Rows.Count, customerCol).End(xlUp).Row
    
    ' 用字典存储唯一非空客户编号
    Set uniqueCustomers = CreateObject("Scripting.Dictionary")
    For i = 2 To lastRow ' 假设第一行是表头
        cust = ws.Cells(i, customerCol).Value
        If cust <> "" And Not uniqueCustomers.Exists(cust) Then
            uniqueCustomers.Add cust, True
        End If
    Next i
    
    ' 关闭屏幕刷新提升效率
    Application.ScreenUpdating = False
    
    ' 遍历每个唯一客户
    For Each cust In uniqueCustomers.Keys
        ' 筛选当前客户
        ws.Range("A1").AutoFilter Field:=customerCol, Criteria1:=cust
        
        ' 检查Months Pay是否有0-4之间的值
        hasInvalidMonths = (WorksheetFunction.CountIfs(ws.Range(ws.Cells(2, monthsPayCol), ws.Cells(lastRow, monthsPayCol)), ">=" & 0, _
                                                      ws.Range(ws.Cells(2, monthsPayCol), ws.Cells(lastRow, monthsPayCol)), "<=" & 4) > 0)
        
        If hasInvalidMonths Then
            ' 删除该客户所有行
            ws.Range("A2:A" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        Else
            ' 检查Own是否有1-5之间的值
            hasInvalidOwn = (WorksheetFunction.CountIfs(ws.Range(ws.Cells(2, ownCol), ws.Cells(lastRow, ownCol)), ">=" & 1, _
                                                      ws.Range(ws.Cells(2, ownCol), ws.Cells(lastRow, ownCol)), "<=" & 5) > 0)
            If hasInvalidOwn Then
                ws.Range("A2:A" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
            End If
        End If
    Next cust
    
    ' 取消筛选，恢复屏幕刷新
    ws.AutoFilterMode = False
    Application.ScreenUpdating = True
    
    MsgBox "处理完成"
End Sub

注意事项 #

• 请根据你的实际表格，修改代码中的工作表名和列号
• 代码假设第一行是表头，数据从第二行开始，若你的表头位置不同，需调整循环起始行
• 执行前建议先备份数据，避免误删

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