VBA 行内容相同时字体变灰

1. 效果

2. 实现代码

Option Explicit

Sub sbSameFontGrey()
    Dim i, j As Long
    Dim rng As Range
    Dim maxUsedRow, maxUsedCol As Long
    Dim ws As Worksheet: Set ws = ActiveSheet

On Error GoTo ErrProcess

    If TypeName(Selection) <> "Range" Then
        MsgBox "Please select a cell range first!", vbExclamation
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    
    maxUsedRow = ws.UsedRange.Row + ws.UsedRange.Rows.Count - 1
    maxUsedCol = ws.UsedRange.Column + ws.UsedRange.Columns.Count - 1
    
    For j = Selection.Column To Selection.Column + Selection.Columns.Count - 1
        For i = Selection.Row + 1 To Selection.Row + Selection.Rows.Count - 1
            Set rng = Cells(i, j)
            rng.Font.Color = RGB(0, 0, 0) 'Color:Black
            If rng.Value = rng.Offset(-1).Value Then rng.Font.Color = RGB(217, 217, 217) 'Color:Grey
            If i > maxUsedRow Then Exit For
        Next
        If j > maxUsedCol Then Exit For
    Next
    
    Application.ScreenUpdating = True
    Exit Sub
ErrProcess:
    Application.ScreenUpdating = True
    MsgBox Err.Description
End Sub