excel选中行高亮代码

Option Explicit

' ========== 可自行修改的配置参数（只改这里，不用动下面代码） ==========

Const START_ROW As Long = 7       ' 从第6行开始生效

Const START_COL As Long = 1       ' 起始A列=1

Const END_COL As Long = 12         ' 结束F列=6

Public Const HIGHLIGHT_YELLOW As Long = 15919333 ' 浅黄色高亮RGB(255,255,153)

' =================================================================

' 全局二维数组：缓存行号 + A-F每列原始色、填充标记

Public g_ColorCache As Variant

Sub RowHighlight(Target As Range)

    Dim colIdx As Long, rowIdx As Long, i As Long

    Dim cell As Range, tmpRows As New Collection

    Dim r As Long

    

    Application.ScreenUpdating = False

    Application.EnableEvents = False

    On Error GoTo ErrRestore

    ' 1、还原上一轮高亮行 A~F 原始底色

    If IsArray(g_ColorCache) Then

        For i = LBound(g_ColorCache) To UBound(g_ColorCache)

            r = g_ColorCache(i, 0)

            For colIdx = START_COL To END_COL

                If g_ColorCache(i, colIdx + END_COL) = True Then

                    Rows(r).Cells(1, colIdx).Interior.Color = g_ColorCache(i, colIdx)

                Else

                    Rows(r).Cells(1, colIdx).Interior.ColorIndex = xlColorIndexNone

                End If

            Next colIdx

        Next i

        Erase g_ColorCache

    End If

    g_ColorCache = Empty

    ' 选中行小于设定起始行，直接退出，清空高亮

    If Target.Row < START_ROW Then GoTo ExitSafe

    ' 2、收集当前选中行，Collection原生去重，兼容Excel2007无报错

    For Each cell In Target

        r = cell.Row

        If r >= START_ROW Then

            On Error Resume Next

            tmpRows.Add r, CStr(r)

            On Error GoTo ErrRestore

        End If

    Next cell

    If tmpRows.Count = 0 Then GoTo ExitSafe

    ' 3、缓存当前选中行A-F每一格原始颜色

    ReDim g_ColorCache(1 To tmpRows.Count, 0 To END_COL * 2)

    For rowIdx = 1 To tmpRows.Count

        r = tmpRows(rowIdx)

        g_ColorCache(rowIdx, 0) = r

        For colIdx = START_COL To END_COL

            g_ColorCache(rowIdx, colIdx) = Rows(r).Cells(1, colIdx).Interior.Color

            g_ColorCache(rowIdx, colIdx + END_COL) = (Rows(r).Cells(1, colIdx).Interior.ColorIndex <> xlColorIndexNone)

        Next colIdx

    Next rowIdx

    ' 4、仅A-F填充浅黄色高亮

    For rowIdx = 1 To tmpRows.Count

        r = tmpRows(rowIdx)

        For colIdx = START_COL To END_COL

            Rows(r).Cells(1, colIdx).Interior.Color = HIGHLIGHT_YELLOW

        Next colIdx

    Next rowIdx

ExitSafe:

    Application.ScreenUpdating = True

    Application.EnableEvents = True

    Exit Sub

ErrRestore:

    Application.ScreenUpdating = True

    Application.EnableEvents = True

    If IsArray(g_ColorCache) Then Erase g_ColorCache

    g_ColorCache = Empty

    MsgBox "异常：" & Err.Description & " 错误号：" & Err.Number, vbCritical

End Sub

' 调用标准模块里的高亮函数

    Call RowHighlight(Target)