VBA批量设置多列条件格式

今天对工作台帐进行了更新，领导增加了要求，现把deepseek的代码保存这里，供以后使用。

Sub AddConditionForRows()
    Dim wsName As String
    Dim targetWs As Worksheet
    Dim row As Integer
    Dim sheetIndex As Integer
    Dim colLetter As Variant
    Dim targetCols As Variant
    Dim formula As String
    
    ' 定义需要处理的列
    targetCols = Array("I", "M")
    
    ' 关闭屏幕更新，提高执行速度
    Application.ScreenUpdating = False
    
    On Error GoTo ErrorHandler
    
    ' 遍历3月1日到3月31日的工作表
    For sheetIndex = 1 To 31
        wsName = "3月" & sheetIndex & "日"
        
        ' 尝试获取工作表
        Set targetWs = Nothing
        On Error Resume Next
        Set targetWs = Worksheets(wsName)
        On Error GoTo 0
        
        If Not targetWs Is Nothing Then
            ' 对每一行进行处理 (2到52行)
            For row = 2 To 52
                ' 对每个目标列应用条件格式
                For Each colLetter In targetCols
                    ' 构建当前行的公式
                    formula = "=AND($D$" & row & "<>""""," & colLetter & "$" & row & "="""")"
                    
                    ' 设置条件格式
                    With targetWs.Range(colLetter & row).FormatConditions
                        .Delete  ' 删除该单元格原有的条件格式
                        .Add Type:=xlExpression, Formula1:=formula
                        .Item(1).Interior.Color = RGB(255, 165, 0)  ' 橙色背景
                    End With
                Next colLetter
            Next row
        End If
    Next sheetIndex
    
    MsgBox "运行结束，共处理 " & sheetIndex - 1 & " 个工作表的 " & (row - 2) * UBound(targetCols) + 1 & " 个单元格"
    
Cleanup:
    Application.ScreenUpdating = True
    Exit Sub

ErrorHandler:
    MsgBox "发生错误: " & Err.Description & " (行: " & row & ", 列: " & colLetter & ")"
    Resume Cleanup
End Sub

另一个版本的，接近原来代码。

Sub AddCondition_OriginalStyle()
    Dim wsName As String
    Dim targetWs As Worksheet
    Dim row As Integer
    Dim sheetIndex As Integer
    Dim startTime As Date
    
    startTime = Now
    Application.ScreenUpdating = False
    
    ' 遍历31天
    For sheetIndex = 1 To 31
        wsName = "3月" & sheetIndex & "日"
        
        ' 检查工作表是否存在
        On Error Resume Next
        Set targetWs = Worksheets(wsName)
        On Error GoTo 0
        
        If Not targetWs Is Nothing Then
            ' 逐行设置 I 列的条件格式
            For row = 2 To 52
                With targetWs.Range("I" & row).FormatConditions
                    .Delete
                    .Add Type:=xlExpression, Formula1:="=AND($D$" & row & "<>"""",$I$" & row & "="""")"
                    .Item(1).Interior.Color = RGB(255, 165, 0)
                End With
            Next row
            
            ' 逐行设置 M 列的条件格式
            For row = 2 To 52
                With targetWs.Range("M" & row).FormatConditions
                    .Delete
                    .Add Type:=xlExpression, Formula1:="=AND($D$" & row & "<>"""",$M$" & row & "="""")"
                    .Item(1).Interior.Color = RGB(255, 165, 0)
                End With
            Next row
        End If
    Next sheetIndex
    
    Application.ScreenUpdating = True
    MsgBox "运行结束，耗时: " & Format(Now - startTime, "hh:mm:ss")
End Sub

有什么需求，就让Deepseek完成。