excel - 突出显示各列每行中的最高值

Question

我想突出显示每行中具有最大值的单元格，但仅使用 F、I、L、O 和 R 列。

Sub Highlights()
    
    Dim ws As Worksheet
    Dim ColorRng As Range
    Dim ColorCell As Range
    
    Set ws = Worksheets("Sheet2")
    Set ColorRng = ws.Range("F7,I7,L7,O7,R7")
    
    'highlight the cell that contains the highest and lowest number
    
    For Each ColorCell In ColorRng
        If ColorCell.Value = Application.WorksheetFunction.Max(ColorRng) Then
            ColorCell.Interior.Color = RGB(0, 180, 40)
        ElseIf ColorCell.Value = Application.WorksheetFunction.Min(ColorRng) Then
            ColorCell.Interior.Color = RGB(255, 0, 0)
        End If
    Next
    
End Sub

它适用于第一行(即第 7 行)，但不会继续到下一行。我意识到这是因为我的 ColorRng 范围。

如何让范围包含更多内容？

Answer 1

请尝试此代码。

Sub SetHighlights()

    Dim ColorRng    As Range
    Dim ColorCell   As Range                ' loop object
    Dim Mini        As Variant
    Dim Maxi        As Variant
    Dim R           As Long                 ' loop counter: rows
    Dim C           As Long                 ' loop counter: columns
    Dim n           As Integer              ' result counter
    
    'highlight the cell that contains the highest and lowest number
    
    Application.ScreenUpdating = False
    With Worksheets("Sheet2")
        For R = 2 To .Cells(.Rows.Count, "F").End(xlUp).Row
            Set ColorRng = Union(.Cells(R, "F"), .Cells(R, "I"), _
                                 .Cells(R, "L"), .Cells(R, "R"))
            Mini = Application.Min(ColorRng)
            Maxi = Application.Max(ColorRng)
            
            For Each ColorCell In ColorRng
                With ColorCell
                    If .Value = Maxi Then
                        .Interior.Color = RGB(0, 180, 40)
                        n = n + 1
                    ElseIf .Value = Mini Then
                        .Interior.Color = RGB(255, 0, 0)
                        n = n + 1
                    End If
                End With
                If n = 2 Then Exit For
            Next ColorCell
        Next R
    End With
    Application.ScreenUpdating = True
End Sub

请注意，Min 和 Max 函数每行仅运行一次，而不是像原始代码那样针对每个单元格运行一次。关闭 ScreenUpdating 可以进一步提高该过程完成作业的速度