You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

如何修改Excel VBA代码仅用两种黄色标记重复数据组

修改Excel VBA代码实现仅用两种颜色标记重复组

原代码通过递增ColorIndex来区分不同重复组,现在要修改为仅使用浅黄色和深黄色两种颜色循环标记不同重复组,具体修改方法如下:

修改后的完整代码

Sub ColorCompanyDuplicates()
'Updateby Extendoffice
Dim xRg, xRgRow As Range
Dim xTxt, xStr As String
Dim xCell, xCellPre As Range
Dim xCurrentColor As Long
Dim xColRows As Collection
Dim xColColors As Collection
Dim I As Long
' 定义两种颜色的ColorIndex:浅黄色(36)、深黄色(44)
Const COLOR_LIGHT_YELLOW As Long = 36
Const COLOR_DARK_YELLOW As Long = 44

If ActiveWindow.RangeSelection.Count > 1 Then
    xTxt = ActiveWindow.RangeSelection.AddressLocal
Else
    xTxt = ActiveSheet.UsedRange.AddressLocal
End If
Set xRg = Application.InputBox("please select the data range:", "Kutools for Excel", xTxt, , , , , 8)
If xRg Is Nothing Then Exit Sub

' 初始化两个集合:一个存行对象,一个存对应颜色
Set xColRows = New Collection
Set xColColors = New Collection
xCurrentColor = COLOR_LIGHT_YELLOW

For I = 1 To xRg.Rows.Count
    On Error Resume Next
    Set xRgRow = xRg.Rows(I)
    xStr = ""
    For Each xCell In xRgRow.Columns
        xStr = xStr & xCell.Text
    Next
    
    ' 尝试从集合获取已存在的行
    xColRows.Add xRgRow, xStr
    If Err.Number = 457 Then
        ' 该组已存在,获取对应颜色并设置
        xCurrentColor = xColColors(xStr)
        xRgRow.Interior.ColorIndex = xCurrentColor
    ElseIf Err.Number = 0 Then
        ' 新的组,设置当前颜色并切换下一个组的颜色
        xRgRow.Interior.ColorIndex = xCurrentColor
        xColColors.Add xCurrentColor, xStr
        ' 切换颜色:浅黄和深黄循环
        xCurrentColor = IIf(xCurrentColor = COLOR_LIGHT_YELLOW, COLOR_DARK_YELLOW, COLOR_LIGHT_YELLOW)
    ElseIf Err.Number = 9 Then
        MsgBox "Too many duplicate companies!", vbCritical, "Kutools for Excel"
        Exit Sub
    End If
    On Error GoTo 0
Next
End Sub

关键修改说明

  • 新增两个常量COLOR_LIGHT_YELLOW和COLOR_DARK_YELLOW,固定两种颜色的索引值,后续可直接修改常量值调整颜色
  • 新增xColColors集合,专门记录每个重复组对应的颜色,确保同一组的所有重复行颜色一致
  • 去掉原代码中xCIndex递增的逻辑,改为在两种颜色间循环切换:每遇到一个新的重复组,就切换到另一种颜色
  • 调整错误处理后的逻辑分支:已存在的重复组直接复用对应颜色,新组则设置当前颜色并预切换下一组的颜色

内容的提问来源于stack exchange,提问作者Taimoor Ahmed

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.07.26 18:32:42