Excel VBA按日期及相邻对勾设置单元格格式并筛选实现求助

修正后的单元格颜色设置代码 #

你原来的代码主要存在3个逻辑问题：

1. 日期判断顺序颠倒：小于当前日期的判断应该放在小于当前日期+30前面，否则所有早于当前+30天的日期都会先命中橙色条件，红色填充永远不会触发
2. 没有提前判断单元格值类型：空值、对勾等非日期内容会被误参与日期比较，导致空单元格被错误填充橙色
3. 对勾匹配时只修改了左侧日期单元格的颜色，没有修改对勾单元格自身的绿色

修正后的代码如下：

Sub 单元格格式批量设置()
    Dim ws As Worksheet
    Dim cell As Range
    Dim lastRow As Long
    
    Set ws = Worksheets("Base Data")
    ' 动态获取最后一行有数据的行号，避免遍历无效空行提升运行效率
    lastRow = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row
    
    For Each cell In ws.Range("F3:P" & lastRow)
        ' 对勾判断优先级最高
        If cell.Value = ChrW(&H2713) Then
            cell.Interior.Color = RGB(146, 208, 80)
            cell.Offset(0, -1).Interior.Color = RGB(146, 208, 80)
        ' 仅对日期类型单元格做颜色判断
        ElseIf IsDate(cell.Value) Then
            If cell.Value < Date Then
                cell.Interior.Color = RGB(255, 0, 0)
            ElseIf cell.Value < Date + 30 Then
                cell.Interior.Color = RGB(255, 192, 80)
            Else
                ' 超过30天的日期清空填充色
                cell.Interior.ColorIndex = xlNone
            End If
        Else
            ' 非日期、非对勾的单元格清空填充色
            cell.Interior.ColorIndex = xlNone
        End If
    Next
End Sub

筛选含橙色/红色单元格行的代码 #

Sub 筛选待处理行()
    Dim ws As Worksheet
    Dim lastRow As Long, lastCol As Long
    Dim i As Long, j As Long
    Dim isNeedFilter As Boolean
    
    Set ws = Worksheets("Base Data")
    lastRow = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row
    lastCol = ws.Cells(3, ws.Columns.Count).End(xlToLeft).Column
    
    ' 先清空之前的筛选状态
    If ws.AutoFilterMode Then ws.AutoFilterMode = False
    
    ' 新增临时辅助列做筛选标记
    ws.Cells(2, lastCol + 1).Value = "筛选标记"
    For i = 3 To lastRow
        isNeedFilter = False
        For j = 6 To lastCol
            ' 判断单元格是否为橙色或红色
            If ws.Cells(i, j).Interior.Color = RGB(255, 0, 0) Or _
               ws.Cells(i, j).Interior.Color = RGB(255, 192, 80) Then
                isNeedFilter = True
                Exit For
            End If
        Next j
        ws.Cells(i, lastCol + 1).Value = IIf(isNeedFilter, "是", "否")
    Next i
    
    ' 执行筛选，只保留含橙/红色单元格的行
    ws.Range("A2:" & Cells(lastRow, lastCol + 1).Address).AutoFilter Field:=lastCol + 1, Criteria1:="是"
End Sub

使用说明 #

1. 两个宏放在同一个模块中即可
2. 要添加页面按钮的话，点击「开发工具」-「插入」-「按钮（窗体控件）」，在页面顶部绘制按钮后，选择对应要绑定的宏名称即可
3. 每次数据更新后先运行「单元格格式批量设置」更新颜色，再运行筛选宏即可得到需要的结果

效果示例：

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