Higlight以不同颜色复制（以及连接的整行）EXCEL

我有一张订单明细表。在G列中，一个特定值指示订单包装在哪个集装箱（装运集装箱）中

我希望所有重复的集装箱编号都用不同的颜色突出显示，并与它们一起显示行

意思是：当我有“容器号X”时，连接到X的整行是一种颜色，连接到“容器号Y”的行是另一种颜色，依此类推

我还想自动更新颜色时，一些变化或当我点击“更新值”在数据栏

G列中的空白单元格不应着色

这可能吗？如果可能的话，有人能帮我吗。我是VBA的初学者

Sub ColorCompanyDuplicates()
'Updateby Extendoffice
Dim xRg As Range
Dim xTxt As String
Dim xCell As Range
Dim xChar As String
Dim xCellPre As Range
Dim xCIndex As Long
Dim xCol As Collection
Dim I As Long
On Error Resume Next
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
xCIndex = 2
Set xCol = New Collection
For Each xCell In xRg
On Error Resume Next
If xCell.Value <> "" Then
xCol.Add xCell, xCell.Text
If Err.Number = 457 Then
xCIndex = xCIndex + 1
Set xCellPre = xCol(xCell.Text)
If xCellPre.Interior.ColorIndex = xlNone Then xCellPre.Interior.ColorIndex = xCIndex
xCell.Interior.ColorIndex = xCellPre.Interior.ColorIndex
ElseIf Err.Number = 9 Then
MsgBox "Too many duplicate companies!", vbCritical, "Kutools for Excel"
Exit Sub
End If
On Error GoTo 0
End If
Next
End Sub

Sub-ColorCompanyDuplicates（）
'由Extendoffice更新
Dim xRg As范围
Dim xTxt作为字符串
Dim xCell As范围
Dim xChar As字符串
Dim Xcellas范围
与索引一样长
Dim xCol作为集合
我想我会坚持多久
出错时继续下一步
如果ActiveWindow.RangeSelection.Count>1，则
xTxt=ActiveWindow.RangeSelection.AddressLocal
其他的
xTxt=ActiveSheet.UsedRange.AddressLocal
如果结束
设置xRg=Application.InputBox（“请选择数据范围：”、“Kutools for Excel”、xTxt、、8）
如果xRg为Nothing，则退出Sub
xCIndex=2
Set xCol=新集合
对于xRg中的每个xCell
出错时继续下一步
如果xCell.Value为“”，则
添加xCell，xCell.Text
如果错误编号=457，则
xindex=xindex+1
设置xCellPre=xCol（xCell.Text）
如果xCellPre.Interior.ColorIndex=xlNone，则xCellPre.Interior.ColorIndex=xcdex
xCell.Interior.ColorIndex=xCellPre.Interior.ColorIndex
ElseIf Err.Number=9，则
MsgBox“重复公司太多！”，vbCritical，“Kutools for Excel”
出口接头
如果结束
错误转到0
如果结束
下一个
端接头

此代码不包括数字1和3

而且，它只使用明亮的颜色

Sub-ColorCompanyDuplicates（）
变暗行\起始行长，最后行长，颜色\索引长
变暗R一样长，最后一个颜色一样长，颜色一样长
将使用的范围变暗为范围，将行绘制为布尔值
'配置-------------------------
row_start=5'数据集的第一行
如果要仅绘制列，请将“绘制行=True”设置为false
'--------------------------------
颜色指数=33
设置使用范围=ActiveSheet.UsedRange
最后一列=_
used_range.Columns.Count+used_range.Column-1
最后一行=_
单元格（Rows.Count，7）.结束（xlUp）.行
'清除容器名称中的现有行
对于R=行，从开始到最后一行
如果范围（“g”&R）”，则
范围（“g”&R）.Value=Split（范围（“g”&R）.Value“”）（0）
如果结束
下一个R
“画复制品
对于R=行，从开始到最后一行
'如果下一个容器名称相同且不为null，则绘制
如果单元格（R，7）=单元格（R+1，7）和单元格（R，7）”，则
如果是油漆，那么
For col=已使用的列到最后一列
单元格（R，col）.Interior.ColorIndex=颜色索引
下一列
其他的
For col=已使用的列到最后一列
单元格（R，col）.Interior.ColorIndex=0
下一列
单元格（R，7）.Interior.ColorIndex=颜色索引
如果结束
“为了小组中的最后一个
'如果预览容器名称相同且不为null，则绘制
ElseIf Cells（R，7）=Cells（R-1，7）和Cells（R，7）”，然后
如果是油漆，那么
For col=已使用的列到最后一列
单元格（R，col）.Interior.ColorIndex=颜色索引
下一列
其他的
For col=已使用的列到最后一列
单元格（R，col）.Interior.ColorIndex=0
下一列
单元格（R，7）.Interior.ColorIndex=颜色索引
如果结束
'并为下一组更改颜色
颜色索引=颜色索引+1
“避免深色
如果颜色指数=46，则
颜色指数=33
如果结束
如果结束
下一个R
'将行号添加到容器名称
对于R=行，从开始到最后一行
如果范围（“g”&R）”，则
单元格（R，7）=单元格（R，7）和“行：”&R
如果结束
下一个R
端接头

---

我建议2号只需创建一个刷新按钮或命令快捷方式。

欢迎，您似乎希望我们为您的工作提供帮助。上传你的尝试。如果你能上传一张工作表的图片，这也会很有用。描述写得很差。你说的集装箱是什么意思？谢谢！我编辑了我写得不好的描述，并在表格上加了一小段。集装箱，我指的是运输集装箱。我之前的尝试在描述中，但这只突出显示了G列中的重复项，并且必须在进行更改时运行。更好的是@makaIf I can我会为您烤一块蛋糕作为感谢！非常感谢！Gassz-有可能突出显示整行而不是一行中的一个单元格吗？@maka我想吃那个蛋糕。是的，这是可能的。我修改了密码。现在，您可以在绘制整行或仅绘制列之间进行选择。您可以在配置部分进行此更改。此外，我还更改了第一行的输入，因此您不必每次运行宏时都将其写入输入框。您也可以在配置区域中对此进行更改。如果你想支持我，别忘了检查答案。您还可以通过给我买杯咖啡来支持我。在运行之前，请不要忘记更改配置部分中的row_start值。

Sub ColorCompanyDuplicates()

Dim row_start As Long, last_row As Long, color_index As Long
Dim R As Long, last_col As Long, col As Long
Dim used_range As Range, paint_row As Boolean

'CONFIG -------------------------
row_start = 5 'first row of the data set
paint_row = True 'set to false if you want to paint only the column
'--------------------------------

color_index = 33
Set used_range = ActiveSheet.UsedRange

last_col = _
used_range.Columns.Count + used_range.Column - 1

last_row = _
Cells(Rows.Count, 7).End(xlUp).Row

'clean existing rows in container names
For R = row_start To last_row
    If Range("g" & R) <> "" Then
        Range("g" & R).Value = Split(Range("g" & R).Value, " ")(0)
    End If
Next R

'paint duplicates
For R = row_start To last_row

    'if the next container name is the same and is not null then paint
    If Cells(R, 7) = Cells(R + 1, 7) And Cells(R, 7) <> "" Then
        
        If paint_row Then
        
            For col = used_range.Column To last_col
                Cells(R, col).Interior.ColorIndex = color_index
            Next col
            
            Else
            For col = used_range.Column To last_col
                Cells(R, col).Interior.ColorIndex = 0
            Next col
            Cells(R, 7).Interior.ColorIndex = color_index
            
        End If
        
    'FOR THE LAST ONE in the group
    'if previews container name is the same and is not null then paint
    ElseIf Cells(R, 7) = Cells(R - 1, 7) And Cells(R, 7) <> "" Then
        
        If paint_row Then
            
            For col = used_range.Column To last_col
                Cells(R, col).Interior.ColorIndex = color_index
            Next col
            
            Else
            For col = used_range.Column To last_col
                Cells(R, col).Interior.ColorIndex = 0
            Next col
            Cells(R, 7).Interior.ColorIndex = color_index
            
        End If
        
        'and change color for the next group
        color_index = color_index + 1
        
        'avoid dark colors
        If color_index = 46 Then
            color_index = 33
        End If
        
    End If
    
Next R

'add row numbers to containers name
For R = row_start To last_row
      If Range("g" & R) <> "" Then
        Cells(R, 7) = Cells(R, 7) & " ROW:" & R
     End If
Next R

End Sub