我有一张包含订单详细信息的表。 G 列中的特定值指示订单装在哪个容器(运输容器)中。 screenshot
- 我想要所有重复的容器号。用不同的颜色和它们所在的行来突出显示。
含义:当我有“容器号 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
最佳答案
此代码执行第 1 点和第 3 点。
此外,它只使用明亮的颜色。
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
我建议第二点只需创建一个刷新按钮或命令快捷方式。
关于excel - 用不同颜色突出显示重复项(以及连接的整行)EXCEL,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/66026740/