如何修改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
相关产品推荐
相关产品推荐

