如何在VBA中同时按多列多条件筛选Excel数据？

方法一：AutoFilter 实现 #

AutoFilter处理多排除条件需要分步操作，以下代码先定位目标列，再分日期场景设置筛选规则，同时排除指定分组和空值：

Sub AutoFilterByConditions()
    Dim ws As Worksheet
    Dim assignCol As Long, dateCol As Long
    Dim todayDate As Date, thresholdDate As Date
    Dim lastRow As Long
    Dim excludeArr As Variant
    
    ' 指定目标工作表，可根据实际修改
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    ' 查找目标列的列号
    On Error Resume Next
    assignCol = ws.Rows(1).Find(What:="Assignment Group", LookIn:=xlValues, LookAt:=xlWhole).Column
    dateCol = ws.Rows(1).Find(What:="Date", LookIn:=xlValues, LookAt:=xlWhole).Column
    On Error GoTo 0
    
    ' 检查列是否存在
    If assignCol = 0 Or dateCol = 0 Then
        MsgBox "未找到""Assignment Group""或""Date""列", vbExclamation
        Exit Sub
    End If
    
    ' 获取数据最后一行
    lastRow = ws.Cells(ws.Rows.Count, assignCol).End(xlUp).Row
    
    ' 清除现有筛选
    ws.AutoFilterMode = False
    
    ' 计算日期阈值
    todayDate = Date
    If Weekday(todayDate, vbMonday) = 1 Then ' 当日为周一
        thresholdDate = todayDate - 4
    Else
        thresholdDate = todayDate - 2
    End If
    
    ' 第一步：筛选出需排除的分组和空值并隐藏
    excludeArr = Array("ITO LUX AAT Wintel", "SAP Basis NTT", "")
    ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, dateCol)).AutoFilter _
        Field:=assignCol, _
        Criteria1:=excludeArr, _
        Operator:=xlFilterValues
    
    ws.Range(ws.Cells(2, assignCol), ws.Cells(lastRow, assignCol)).SpecialCells(xlCellTypeVisible).EntireRow.Hidden = True
    ws.AutoFilterMode = False
    
    ' 第二步：根据日期规则筛选
    If Weekday(todayDate, vbMonday) = 1 Then
        ' 周一：仅筛选大于阈值的日期
        ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, dateCol)).AutoFilter _
            Field:=dateCol, _
            Criteria1:=">" & CLng(thresholdDate)
    Else
        ' 非周一：筛选大于阈值的日期或空值
        ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, dateCol)).AutoFilter _
            Field:=dateCol, _
            Criteria1:=">" & CLng(thresholdDate), _
            Operator:=xlOr, _
            Criteria2:="="
    End If
    
    ' 取消符合条件行的隐藏
    ws.Range(ws.Cells(2, 1), ws.Cells(lastRow, 1)).SpecialCells(xlCellTypeVisible).EntireRow.Hidden = False
End Sub

说明：

• 先通过AutoFilter定位需排除的行并隐藏，再按日期规则筛选，最后恢复符合条件行的显示
• 逻辑清晰易调整，适合中小规模数据量场景

方法二：高级筛选（更适配复杂多条件） #

高级筛选通过构建条件区域实现精确匹配，无需行隐藏操作，效率更高：

Sub AdvancedFilterByConditions()
    Dim ws As Worksheet
    Dim assignCol As Long, dateCol As Long
    Dim todayDate As Date, thresholdDate As Date
    Dim lastRow As Long, criteriaRow As Long
    Dim criteriaRange As Range
    
    ' 指定目标工作表
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    ' 查找目标列
    On Error Resume Next
    assignCol = ws.Rows(1).Find(What:="Assignment Group", LookIn:=xlValues, LookAt:=xlWhole).Column
    dateCol = ws.Rows(1).Find(What:="Date", LookIn:=xlValues, LookAt:=xlWhole).Column
    On Error GoTo 0
    
    If assignCol = 0 Or dateCol = 0 Then
        MsgBox "未找到目标列", vbExclamation
        Exit Sub
    End If
    
    ' 计算日期阈值
    todayDate = Date
    If Weekday(todayDate, vbMonday) = 1 Then
        thresholdDate = todayDate - 4
    Else
        thresholdDate = todayDate - 2
    End If
    
    ' 获取数据最后一行
    lastRow = ws.Cells(ws.Rows.Count, assignCol).End(xlUp).Row
    
    ' 创建临时条件区域（使用Z列空白区域，可根据实际调整）
    criteriaRow = 1
    ws.Cells(criteriaRow, "Z").Value = "Assignment Group"
    ws.Cells(criteriaRow, "AA").Value = "Date"
    criteriaRow = criteriaRow + 1
    
    ' 添加分组排除+日期大于阈值的组合条件
    ws.Cells(criteriaRow, "Z").Value = "<>ITO LUX AAT Wintel"
    ws.Cells(criteriaRow, "AA").Value = ">" & thresholdDate
    criteriaRow = criteriaRow + 1
    ws.Cells(criteriaRow, "Z").Value = "<>SAP Basis NTT"
    ws.Cells(criteriaRow, "AA").Value = ">" & thresholdDate
    criteriaRow = criteriaRow + 1
    ws.Cells(criteriaRow, "Z").Value = "<>"
    ws.Cells(criteriaRow, "AA").Value = ">" & thresholdDate
    
    ' 非周一添加分组排除+日期空值的组合条件
    If Weekday(todayDate, vbMonday) <> 1 Then
        criteriaRow = criteriaRow + 1
        ws.Cells(criteriaRow, "Z").Value = "<>ITO LUX AAT Wintel"
        ws.Cells(criteriaRow, "AA").Value = "="
        criteriaRow = criteriaRow + 1
        ws.Cells(criteriaRow, "Z").Value = "<>SAP Basis NTT"
        ws.Cells(criteriaRow, "AA").Value = "="
        criteriaRow = criteriaRow + 1
        ws.Cells(criteriaRow, "Z").Value = "<>"
        ws.Cells(criteriaRow, "AA").Value = "="
    End If
    
    ' 定义条件区域
    Set criteriaRange = ws.Range(ws.Cells(1, "Z"), ws.Cells(criteriaRow, "AA"))
    
    ' 执行高级筛选（结果保留在原区域，可修改为复制到其他区域）
    ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, dateCol)).AdvancedFilter _
        Action:=xlFilterInPlace, _
        CriteriaRange:=criteriaRange, _
        Unique:=False
    
    ' 清除临时条件区域
    criteriaRange.ClearContents
End Sub

说明：

• 动态构建条件区域，每个分组排除规则与日期规则组合成独立条件行，匹配逻辑更精准
• 高级筛选原生支持多复杂条件组合，适合大规模数据场景

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