如何让Excel宏仅在修改行运行并支持全工作簿触发

一、仅在修改行运行宏的实现方案 #

原代码卡顿的核心原因是每次修改都遍历所有行，通过Worksheet_Change事件的Target参数可以精准获取修改的单元格区域，只处理这些区域所在的行，大幅减少计算量。

关键优化点： #

• 利用Target.EntireRow获取修改单元格所在的行
• 对多行修改的情况去重，避免重复处理同一行
• 给Calculate1和ValidNumber添加工作表参数，明确操作对象，避免默认ActiveSheet的潜在问题
• 将全局格式设置（B、K、L列）移至工作表激活事件，避免每次处理行都重复执行

二、工作簿任意工作表触发的实现方案 #

通过ThisWorkbook的SheetChange事件，监听所有工作表的修改操作，同样仅处理修改行。

修改后的完整代码 #

1. Module1（通用模块） #

Function ValidNumber(ws As Worksheet, NUM1 As Integer, NUM2 As Integer) As Boolean
    ' 明确指定工作表，避免ActiveSheet歧义
    If IsNumeric(ws.Cells(NUM1, NUM2).Value) And Not IsEmpty(ws.Cells(NUM1, NUM2).Value) Then
        ValidNumber = True
    Else
        ValidNumber = False
    End If
End Function

Sub Calculate1(ws As Worksheet, NUM As Integer)
    Dim EntryPrice As Double
    Dim ExitPrice As Double
    Dim Invested As Double
    Dim PL As Double
    Dim Margin As Double
    Dim InvestPercentage As Double
    Dim FormatColor As Integer
    
    With ws
        If .Cells(NUM, 6).Value = "L" And ValidNumber(ws, NUM, 7) And ValidNumber(ws, NUM, 8) And ValidNumber(ws, NUM, 10) Then
            EntryPrice = .Cells(NUM, 7)
            ExitPrice = .Cells(NUM, 8)
            Invested = .Cells(NUM, 10)
            
            InvestPercentage = (Invested / EntryPrice) * 100
            PL = ((ExitPrice / 100) * InvestPercentage) - Invested
            Margin = PL / Invested
            
            ' ExitPrice单元格格式设置
            With .Cells(NUM, 8)
                .Font.Color = RGB(255, 255, 255)
                If .Value < .Cells(NUM, 7).Value Then
                    .Interior.ColorIndex = 3
                ElseIf .Value > .Cells(NUM, 7).Value And .Value < .Cells(NUM, 9).Value Then
                    .Interior.Color = RGB(255, 140, 0)
                Else
                    .Interior.ColorIndex = 10
                End If
            End With
            
            ' PL和Margin单元格格式与值设置
            FormatColor = IIf(PL > 0, 10, 3)
            With .Cells(NUM, 11)
                .Value = PL
                .Font.Color = RGB(255, 255, 255)
                .Interior.ColorIndex = FormatColor
            End With
            With .Cells(NUM, 12)
                .Value = Margin
                .Font.Color = RGB(255, 255, 255)
                .Interior.ColorIndex = FormatColor
            End With
            
        ElseIf .Cells(NUM, 6).Value = "S" And ValidNumber(ws, NUM, 7) And ValidNumber(ws, NUM, 8) And ValidNumber(ws, NUM, 10) Then
            EntryPrice = .Cells(NUM, 7)
            ExitPrice = .Cells(NUM, 8)
            Invested = .Cells(NUM, 10)
            
            InvestPercentage = (Invested / EntryPrice) * 100
            PL = ((ExitPrice / 100) * InvestPercentage) - Invested
            Margin = PL / Invested
            
            ' ExitPrice单元格格式设置
            With .Cells(NUM, 8)
                .Font.Color = RGB(255, 255, 255)
                If .Value > .Cells(NUM, 7).Value Then
                    .Interior.ColorIndex = 3
                ElseIf .Value < .Cells(NUM, 7).Value And .Value > .Cells(NUM, 9).Value Then
                    .Interior.Color = RGB(255, 140, 0)
                Else
                    .Interior.ColorIndex = 10
                End If
            End With
            
            ' PL和Margin单元格格式与值设置
            If PL < 0 Then
                PL = Abs(PL)
                Margin = Abs(Margin)
                FormatColor = 10
            Else
                PL = -Abs(PL)
                Margin = -Abs(Margin)
                FormatColor = 3
            End If
            With .Cells(NUM, 11)
                .Value = PL
                .Font.Color = RGB(255, 255, 255)
                .Interior.ColorIndex = FormatColor
            End With
            With .Cells(NUM, 12)
                .Value = Margin
                .Font.Color = RGB(255, 255, 255)
                .Interior.ColorIndex = FormatColor
            End With
            
        Else
            ' 清除格式与内容
            With .Cells(NUM, 8)
                .Interior.Color = xlNone
                .Font.Color = RGB(0, 0, 0)
            End With
            With .Cells(NUM, 11)
                .Interior.Color = xlNone
                .Font.Color = RGB(0, 0, 0)
                .ClearContents
            End With
            With .Cells(NUM, 12)
                .Interior.Color = xlNone
                .Font.Color = RGB(0, 0, 0)
                .ClearContents
            End With
        End If
    End With
End Sub

Sub SetGlobalFormats(ws As Worksheet)
    ' 全局格式设置，仅在初始化或激活时执行一次
    ws.Range("B:B").NumberFormat = "mm/dd/yy"
    ws.Range("K:K").NumberFormat = "$#0.00"
    ws.Range("L:L").NumberFormat = "#0.00000%"
End Sub

Sub CalculateAllRows(ws As Worksheet)
    ' 全量计算时调用（如工作表激活）
    Dim i As Integer
    For i = 3 To ws.UsedRange.Rows.Count + 1
        Calculate1 ws, i
    Next
End Sub

2. 单个工作表（如Sheet1）的事件代码（可选，若需要单个表独立触发） #

Private Sub Worksheet_Activate()
    Application.EnableEvents = False
    SetGlobalFormats Me ' 设置全局格式
    CalculateAllRows Me ' 激活时全量计算一次
    Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    Dim affectedRow As Range
    Dim uniqueRows As Collection
    Set uniqueRows = New Collection
    
    ' 收集所有修改的唯一行
    On Error Resume Next
    For Each affectedRow In Target.EntireRow
        uniqueRows.Add affectedRow.Row, Key:=CStr(affectedRow.Row)
    Next
    On Error GoTo 0
    
    ' 仅处理修改的行
    Dim rowNum As Variant
    For Each rowNum In uniqueRows
        If rowNum >= 3 Then ' 只处理第3行及以下的数据行
            Calculate1 Me, rowNum
        End If
    Next
    
    Application.EnableEvents = True
End Sub

3. ThisWorkbook（工作簿级事件，实现所有工作表触发） #

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Application.EnableEvents = False
    Dim affectedRow As Range
    Dim uniqueRows As Collection
    Set uniqueRows = New Collection
    
    ' 收集所有修改的唯一行
    On Error Resume Next
    For Each affectedRow In Target.EntireRow
        uniqueRows.Add affectedRow.Row, Key:=CStr(affectedRow.Row)
    Next
    On Error GoTo 0
    
    ' 仅处理修改的行
    Dim rowNum As Variant
    For Each rowNum In uniqueRows
        If rowNum >= 3 Then ' 只处理第3行及以下的数据行
            Calculate1 Sh, rowNum
        End If
    Next
    
    ' 首次触发时设置全局格式（可选，避免重复设置）
    If Sh.Range("B:B").NumberFormat <> "mm/dd/yy" Then
        SetGlobalFormats Sh
    End If
    
    Application.EnableEvents = True
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Application.EnableEvents = False
    SetGlobalFormats Sh
    CalculateAllRows Sh
    Application.EnableEvents = True
End Sub

注意事项 #

1. 若不需要单个工作表的独立事件，可删除Sheet1中的Worksheet_Change和Worksheet_Activate，仅保留ThisWorkbook的事件即可
2. 确保数据行从第3行开始，若起始行不同，修改代码中rowNum >= 3的判断值
3. 测试时关闭其他不必要的Excel插件，进一步减少卡顿

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