Excel宏仅更新当前行：请求实现全表变更更新及排序触发更新

1. 提取格式逻辑为独立子过程 #

把原Worksheet_Change中设置行背景色和字体的代码抽成独立子过程，实现多场景复用：

' 处理单行格式的子过程
Private Sub UpdateSingleRowFormatting(ByVal rowNum As Long)
    Dim date1 As Date, date2 As Date, date3 As Date
    
    ' 重置行基础格式
    Range("B" & rowNum & ":AL" & rowNum).Interior.Color = RGB(255, 255, 255)
    Range("B" & rowNum & ":AL" & rowNum).Font.Italic = False
    
    ' 处理状态为0的行
    If Range("B" & rowNum).Value = 0 Then
        date1 = Range("J" & rowNum) ' 工作日期
        date2 = Range("AN1")       ' 当前日期（建议直接用Date函数，避免依赖单元格）
        date3 = Range("Y" & rowNum) ' 预计天数
        
        ' 非启动项目逻辑
        If Range("L" & rowNum).Value <> "X" Then
            ' 未完成所有字段：黄色背景
            If Application.CountIf(Range("L" & rowNum & ":V" & rowNum), "X") + _
               Application.CountIf(Range("L" & rowNum & ":V" & rowNum), "N/A") < 11 Then
                Range("B" & rowNum & ":Z" & rowNum).Interior.Color = vbYellow
            End If
            ' 当前进行中：橙色背景
            If date2 >= date1 And date2 <= date1 + date3 Then
                Range("B" & rowNum & ":Z" & rowNum).Interior.Color = RGB(255, 153, 0)
            End If
        End If
        
        ' 日期过期且未完成：浅红背景
        If Application.CountIf(Range("L" & rowNum & ":V" & rowNum), "X") + _
           Application.CountIf(Range("L" & rowNum & ":V" & rowNum), "N/A") < 11 Then
            If Range("J" & rowNum).Value <> "" And Range("J" & rowNum).Value <= Date Then
                Range("B" & rowNum & ":AL" & rowNum).Interior.Color = RGB(255, 205, 205)
            End If
        End If
        
        ' 启动项目逻辑
        If Range("L" & rowNum).Value = "X" Then
            ' 未完成所有字段：黄色背景
            If (Application.CountIf(Range("L" & rowNum & ":V" & rowNum), "X") + _
                Application.CountIf(Range("L" & rowNum & ":V" & rowNum), "N/A") < 11) Or _
               (Application.CountIf(Range("AA" & rowNum & ":AL" & rowNum), "X") + _
                Application.CountIf(Range("AA" & rowNum & ":AL" & rowNum), "N/A") < 12) Then
                Range("B" & rowNum & ":AL" & rowNum).Interior.Color = vbYellow
            End If
            ' 当前进行中：橙色背景
            If date2 >= date1 And date2 <= date1 + date3 Then
                Range("B" & rowNum & ":Z" & rowNum).Interior.Color = RGB(255, 153, 0)
            End If
        End If
        
        ' 启动项目且日期过期：浅红背景
        If Range("L" & rowNum).Value = "X" Then
            If (Application.CountIf(Range("L" & rowNum & ":V" & rowNum), "X") + _
                Application.CountIf(Range("L" & rowNum & ":V" & rowNum), "N/A") < 11) Or _
               (Application.CountIf(Range("Z" & rowNum & ":AL" & rowNum), "X") + _
                Application.CountIf(Range("Z" & rowNum & ":AL" & rowNum), "N/A") < 12) Then
                If Range("J" & rowNum).Value <= Date Then
                    Range("B" & rowNum & ":AL" & rowNum).Interior.Color = RGB(255, 205, 205)
                End If
            End If
        End If
        
        ' 无日期的待处理行：绿色背景
        If Range("J" & rowNum).Value = "" Then
            Range("B" & rowNum & ":AL" & rowNum).Interior.Color = RGB(98, 192, 96)
        End If
        
        ' 超期时长：红色背景
        If Range("Z" & rowNum).Value > Range("Y" & rowNum).Value Then
            Range("B" & rowNum & ":AL" & rowNum).Interior.Color = RGB(255, 49, 1)
        End If
    End If
    
    ' 状态为1：斜体
    If Range("B" & rowNum).Value = 1 Then
        Range("B" & rowNum & ":AL" & rowNum).Font.Italic = True
    End If
    
    ' 状态为2：青色背景
    If Range("B" & rowNum).Value = 2 Then
        Range("B" & rowNum & ":AL" & rowNum).Interior.Color = vbCyan
        ' 启动项目完成：紫色背景
        If Range("L" & rowNum).Value <> "X" Then
            Range("B" & rowNum & ":AL" & rowNum).Interior.Color = RGB(172, 117, 213)
        End If
    End If
End Sub

' 处理全表格式的子过程
Private Sub UpdateAllRowsFormatting()
    Dim lastRow As Long, i As Long
    lastRow = Range("B" & Rows.Count).End(xlUp).Row
    
    Application.ScreenUpdating = False
    For i = 3 To lastRow ' 从第3行开始，跳过表头
        UpdateSingleRowFormatting i
    Next i
    Application.ScreenUpdating = True
End Sub

2. 修改排序按钮事件 #

修复原代码的语法错误（原代码中ActiveWorkbook.Save后直接拼接其他子过程定义），并在排序完成后触发全表格式更新：

Private Sub CommandButton1_Click()
' Sort button and save a backup copy
    Dim lastrow As Long, start2 As Long
    'Count total number of rows that have data
    lastrow = Range("B" & Rows.Count).End(xlUp).Row
    Range("A3:ZZ" & lastrow).Sort key1:=Range("B3"), key2:=Range("J3"), Header:=xlNo
    'Find the first row, that has a 2
    start2 = Range("B1:B" & lastrow).Find(What:=2, After:=Range("B2"), LookAt:=xlWhole).Row
    Range("A" & start2 & ":ZZ" & lastrow).Sort key1:=Range("L2")
    Selection.Rows.AutoFit
    Range("B3").Select
    Range("B1").Select
    ActiveWorkbook.Save
    
    ' 排序完成后更新全表格式
    UpdateAllRowsFormatting
End Sub

' 拆分后的其他按钮事件（原代码被错误合并）
Private Sub CommandButton_Bottom_row_Click()
' Move_To_bottom_Row Macro
' Keyboard Shortcut: Ctrl Shift + Z
 Worksheets("Coordinator list").Activate
 Range("c1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, -1).Activate
 End Sub

Sub CommandButtonUP_Top_Row_Click()
' Move_To_top_Row Macro
ActiveCell.EntireColumn.Range("a3").Activate
 End Sub

Sub CommandButton_LAST_column_Click()
' Move to last column
ActiveCell.EntireRow.Range("AD1").Activate
End Sub

Sub CommandButton_First_Column_Click()
' Move to first column
ActiveCell.EntireRow.Range("b1").Activate
End Sub

3. 简化Worksheet_Change事件 #

调用独立子过程处理目标行，修复原代码中重复的错误处理和事件开关问题：

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo wsc_exit
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    ' 处理大写转换
    If Target.Cells.Count = 1 Then
        If Not Intersect(Range("E3:H1000, L2:V1000, X2:X1000, AA2:AL1000"), Target) Is Nothing Then
           Target.Value = UCase(Target.Value)
        End If
        
        ' 处理首字母大写转换
        If Not Intersect(Range("I3:I1000, K3:K1000, W3:W1000"), Target) Is Nothing Then
            Target.Value = StrConv(Target.Value, vbProperCase)
        End If
    End If
    
    ' 处理行格式更新
    If Target.CountLarge = 1 Then
        If Not Intersect(Range("A3:ZZ995"), Target) Is Nothing Then
            UpdateSingleRowFormatting Target.Row
        End If
    End If
    
wsc_exit:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    ActiveWorkbook.Save
End Sub

4. 自动更新过期行 #

要实现过期行自动变红（无需手动修改单元格），可以添加工作表激活事件，每次打开工作表时更新全表：

Private Sub Worksheet_Activate()
    UpdateAllRowsFormatting
End Sub

如果需要更实时的更新（比如日期变化时自动触发），可以添加定时检查：

1. 插入标准模块，添加以下代码：

Public UpdateTimer As Double

Sub StartTimer()
    UpdateTimer = Now + TimeValue("00:01:00") ' 每分钟检查一次
    Application.OnTime UpdateTimer, "CheckAndUpdate"
End Sub

Sub StopTimer()
    On Error Resume Next
    Application.OnTime UpdateTimer, "CheckAndUpdate", , False
End Sub

Sub CheckAndUpdate()
    Sheet1.UpdateAllRowsFormatting ' 替换为你的工作表名称
    StartTimer ' 循环定时
End Sub

2. 在工作表事件中启停定时器：

Private Sub Worksheet_Activate()
    StartTimer
    UpdateAllRowsFormatting
End Sub

Private Sub Worksheet_Deactivate()
    StopTimer
End Sub

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