今天对工作台帐进行了更新，领导增加了要求，现把deepseek的代码保存这里，供以后使用。
Sub AddConditionForRows()Dim wsName As StringDim targetWs As WorksheetDim row As IntegerDim sheetIndex As IntegerDim colLetter As VariantDim targetCols As VariantDim formula As String' 定义需要处理的列targetCols = Array("I", "M")' 关闭屏幕更新，提高执行速度Application.ScreenUpdating = FalseOn Error GoTo ErrorHandler' 遍历3月1日到3月31日的工作表For sheetIndex = 1 To 31wsName = "3月" & sheetIndex & "日"' 尝试获取工作表Set targetWs = NothingOn Error Resume NextSet targetWs = Worksheets(wsName)On Error GoTo 0If 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 WithNext colLetterNext rowEnd IfNext sheetIndexMsgBox "运行结束，共处理 " & sheetIndex - 1 & " 个工作表的 " & (row - 2) * UBound(targetCols) + 1 & " 个单元格"Cleanup:Application.ScreenUpdating = TrueExit SubErrorHandler:MsgBox "发生错误: " & Err.Description & " (行: " & row & ", 列: " & colLetter & ")"Resume Cleanup
End Sub
另一个版本的，接近原来代码。
Sub AddCondition_OriginalStyle()Dim wsName As StringDim targetWs As WorksheetDim row As IntegerDim sheetIndex As IntegerDim startTime As DatestartTime = NowApplication.ScreenUpdating = False' 遍历31天For sheetIndex = 1 To 31wsName = "3月" & sheetIndex & "日"' 检查工作表是否存在On Error Resume NextSet targetWs = Worksheets(wsName)On Error GoTo 0If Not targetWs Is Nothing Then' 逐行设置 I 列的条件格式For row = 2 To 52With targetWs.Range("I" & row).FormatConditions.Delete.Add Type:=xlExpression, Formula1:="=AND($D$" & row & "<>"""",$I$" & row & "="""")".Item(1).Interior.Color = RGB(255, 165, 0)End WithNext row' 逐行设置 M 列的条件格式For row = 2 To 52With targetWs.Range("M" & row).FormatConditions.Delete.Add Type:=xlExpression, Formula1:="=AND($D$" & row & "<>"""",$M$" & row & "="""")".Item(1).Interior.Color = RGB(255, 165, 0)End WithNext rowEnd IfNext sheetIndexApplication.ScreenUpdating = TrueMsgBox "运行结束，耗时: " & Format(Now - startTime, "hh:mm:ss")
End Sub
有什么需求，就让Deepseek完成。