Excel VBA脚本需求：实现CUSIP号码分组交替高亮（解决单元格跳转问题）

原始代码 #

Sub dupColors()
     Dim i As Long, cIndex As Long
     cIndex = 3
     Cells(1, 1).Interior.ColorIndex = cIndex
     For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        If Cells(i, 1) = Cells(i + 1, 1) Then
           Cells(i + 1, 1).Interior.ColorIndex = cIndex
       Else
           If Cells(i + 1, 1) <> "" Then
               cIndex = cIndex + 1
               Cells(i + 1, 1).Interior.ColorIndex = cIndex
           End If
       End If
   Next i
End Sub

需求与问题 #

• 需求：对已排序分组的动态CUSIP号码进行分组高亮，不同组自动切换颜色
• 问题：单元格序号可能跳变（如存在空行），原代码依赖i+1的行号对比逻辑失效

解决思路 #

1. 放弃行号依赖，直接跟踪当前组的CUSIP值作为分组判断依据
2. 先获取完整的非空数据范围，确保只处理有效数据
3. 使用颜色列表循环切换，避免ColorIndex超出Excel有效范围
4. 用For Each遍历数据区域，适配行号跳变的场景

优化后的代码 #

Sub HighlightCUSIPGroups()
    Dim ws As Worksheet
    Dim dataRange As Range
    Dim cell As Range
    Dim currentCUSIP As String
    Dim currentColorIndex As Long
    Dim colorList As Variant
    
    ' 指定目标工作表（可根据实际修改）
    Set ws = ActiveSheet
    ' 获取A列非空数据的动态范围
    Set dataRange = ws.Range("A1:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
    
    ' 定义循环使用的颜色索引数组（避免ColorIndex越界）
    colorList = Array(3, 4, 5, 6, 7, 8, 9, 10, 11)
    currentColorIndex = LBound(colorList)
    currentCUSIP = dataRange.Cells(1, 1).Value
    
    ' 初始化第一个单元格的颜色
    dataRange.Cells(1, 1).Interior.ColorIndex = colorList(currentColorIndex)
    
    ' 遍历所有数据单元格
    For Each cell In dataRange.Cells
        ' 跳过第一个已初始化的单元格
        If cell.Row = dataRange.Cells(1, 1).Row Then GoTo NextCell
        
        ' 判断当前单元格是否属于当前组
        If cell.Value = currentCUSIP Then
            ' 同组，应用当前颜色
            cell.Interior.ColorIndex = colorList(currentColorIndex)
        Else
            ' 切换组，更新颜色和当前CUSIP标记
            currentColorIndex = currentColorIndex + 1
            If currentColorIndex > UBound(colorList) Then
                currentColorIndex = LBound(colorList)
            End If
            currentCUSIP = cell.Value
            cell.Interior.ColorIndex = colorList(currentColorIndex)
        End If
        
NextCell:
    Next cell
End Sub

代码说明 #

• 用dataRange锁定有效数据范围，空行或跳变行号不会影响遍历
• 通过currentCUSIP跟踪当前组的标识，完全不依赖行号连续性
• 颜色列表循环使用，避免颜色索引超出Excel的有效范围（1-56）
• 明确指定工作表，避免全局Cells操作导致的错误

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