将工作台帐优化一下，高亮显示当日订单，好处是工作完成度一目也然。
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)If Sh.Name Like "*月*日" ThenDim affectedRange As RangeSet affectedRange = Intersect(Target, Sh.Columns("B"))If affectedRange Is Nothing ThenExit SubEnd IfApplication.EnableEvents = FalseDim cell As RangeFor Each cell In affectedRangeIf Trim(cell.Value) <> "" Then' B列非空：K列和L列赋值为"无"Sh.Cells(cell.Row, "K").Value = "无"Sh.Cells(cell.Row, "L").Value = "无"Sh.Cells(cell.Row, "A").Font.Color = RGB(0, 0, 0)Sh.Cells(cell.Row, "A").Interior.Color = xlNoneElse' B列为空：清除K列和L列内容ifSh.Cells(cell.Row, "K").ClearContentsSh.Cells(cell.Row, "L").ClearContentsSh.Cells(cell.Row, "G").ClearContentsSh.Cells(cell.Row, "M").ClearContentsSh.Cells(cell.Row, "A").Font.Color = RGB(255, 255, 255)Sh.Cells(cell.Row, "A").Interior.Color = RGB(218, 165, 32)End IfNext cellApplication.EnableEvents = TrueEnd If
End SubPrivate Sub Workbook_Open()InitOrdersFormatEnd SubPrivate Function GetCurrentWorksheetName() As StringDim currentDate As DatecurrentDate = GetCurrentDate()GetCurrentWorksheetName = Format(currentDate, "m月d日")
End FunctionPrivate Function GetCurrentDate() As DateIf Hour(Now) >= 20 ThenGetCurrentDate = DateAdd("d", 1, Date)
ElseGetCurrentDate = Date
End IfEnd FunctionPrivate Function GetCurrentOrders() As Variant
Dim mondayStr As String
Dim tuesdayStr As String
Dim wednesdayStr As String
Dim thursdayStr As String
Dim fridayStr As String
Dim saturdayStr As String
Dim sundayStr As String
Dim weekdayNum As Integer
Dim orders As Variant
Dim sheetName As StringmondayStr = "参考消息,长江商报,都市报省版,都市报市版,法治日报,工人日报,光明日报,国家电网,湖北日报,检察日报,健康报,金融时报,经济参考,经济日报,科技日报,农民日报,人民法院,人民铁道,仙桃日报,新华电讯,中国妇女,中国青年,中国日报,中国社会,中国石化,中国证券"tuesdayStr = "湖北日报,光明日报,农民日报,健康报,金融时报,人民铁道,中国石化,人民法院,国家电网,科技日报,中国证券,参考消息,工人日报,法治日报,中国青年,仙桃日报,武汉铁道,人民武警,都市报省版,中国社会,文摘周报,中国妇女,中国日报,检察日报,长江商报,经济参考,经济日报,都市报市版,水利报,新华电讯"wednesdayStr = "湖北日报,都市报市版,农村新报,工作日报,新华电讯,健康报,金融时报,科技日报,国家电网报,中国证券,参考消息,法治日报,经济参考,农民日报,人民铁道,仙桃日报,新洲报,人民武警,都市报省版,中国石化,水利报,中国妇女,中国日报,长江商报,中国社会,检察日报,中国青年,经济日报,快乐老人,人民法院,亮报,光明日报"thursdayStr = "湖北日报,法治日报,工人日报,光明日报,健康报,金融时报,中国石化,中国证券,水利报,科技日报,参考消息,农民日报,中国青年,经济参考,新华电讯,中国社会,人民武警,仙桃日报,都市报省版,文摘周报,人民法院,中国妇女,中国日报,长江商报,检察日报,都市报市版,南方周末,经济日报,人民铁道,国家电网"fridayStr = "参考消息,长江商报,都市报省版,都市报市版,水利报,健康报,人民铁道,人民武警,法治日报,工人日报,光明日报,国家电网,湖北日报,检察日报,金融时报,经济参考,经济日报,科技日报,农民日报,人民法院,武汉铁道,仙桃日报,新华电讯,中国妇女,中国青年,中国日报,中国社会,中国石化,中国证券"saturdayStr = "湖北日报,农村新报,中国证券,新华电讯,检察日报,参考消息,法治日报,中国青年,都市报省版,水利报,中国妇女,人民武警,人民法院,中国日报（1-12）,书法报,工人日报,经济日报,快乐老人,都市报市版,光明日报,农民日报,人民铁道"sundayStr = "湖北日报,参考消息,新华电讯,法治日报,工人日报,中国青年,中国妇女,检察日报,人民法院,人民铁道,经济日报,都市报市版,光明日报"sheetName = GetCurrentWorksheetName()Select Case sheetNameCase "5月1日": GetCurrentOrders = Split("湖北日报,都市报市版,参考消息,中国青年,经济日报,新华电讯,光明日报,中国日报（1-12）", ",")Exit FunctionCase "5月2日": GetCurrentOrders = Split("湖北日报,都市报市版,参考消息,中国青年,经济日报,新华电讯,光明日报,中国日报（1-12）,农民日报", ",")Exit FunctionCase "5月3日": GetCurrentOrders = Split("湖北日报,都市报市版,参考消息,中国青年,经济日报,新华电讯,光明日报,中国日报（1-12）,农民日报", ",")Exit FunctionCase "5月4日": GetCurrentOrders = Split("湖北日报,都市报市版,参考消息,中国青年,经济日报,新华电讯,光明日报,中国日报（1-12）", ",")Exit Function
End SelectweekdayNum = Weekday(GetCurrentDate, vbSunday)Select Case weekdayNumCase 1: orders = Split(sundayStr, ",")Case 2: orders = Split(mondayStr, ",")Case 3: orders = Split(tuesdayStr, ",")Case 4: orders = Split(wednesdayStr, ",")Case 5: orders = Split(thursdayStr, ",")Case 6: orders = Split(fridayStr, ",")Case 7: orders = Split(saturdayStr, ",")Case Else: Exit Function
End SelectGetCurrentOrders = orders
End FunctionPrivate Sub InitOrdersFormat()
Dim orders As Variant
Dim cell As Range
Dim aRng As Range
Dim ws As Worksheet
Dim order As Variant
Dim worksheetName As String
Dim shouldHighlight As BooleanworksheetName = GetCurrentWorksheetName()Set ws = Worksheets(worksheetName)
orders = GetCurrentOrders()If ws Is Nothing Then Exit Sub
If ws.ProtectContents Then Exit Sub
If Not IsArray(orders) Then Exit SubSet aRng = ws.Range("a2:a52")
Application.ScreenUpdating = False
Application.EnableEvents = False
ws.ActivateFor Each cell In aRngshouldHighlight = FalseIf Len(Trim(cell.Value)) > 0 ThenFor Each order In ordersIf InStr(1, cell.Value, order, vbTextCompare) > 0 ThenIf IsEmpty(cell.Offset(0, 1)) ThenshouldHighlight = TrueEnd IfExit ForEnd IfNext orderEnd IfIf shouldHighlight Thencell.Font.Color = RGB(255, 255, 255)cell.Interior.Color = RGB(218, 165, 32)Elsecell.Font.Color = RGB(0, 0, 0)cell.Interior.Color = xlNoneEnd IfNext cell
Application.ScreenUpdating = True
Application.EnableEvents = TrueEnd Sub
在千问的帮助下完成，AI写单个方法或函数是没有问题的。