Вы можете быть заинтересованы в этом макросе. Я думаю, что это именно то, что вы хотите сейчас.
Sub ColorIndex()
Dim x As Integer
Dim y As Integer
Dim lRows As Long
Dim lColNum As Long
Dim iColor As Integer
Dim iDupes As Integer
Dim bFlag As Boolean
lRows = Selection.Rows.Count
lColNum = Selection.Column
iColor = 2
For x = 2 To lRows
bFlag = False
For y = 2 To x - 1
If Cells(y, lColNum) = Cells(x, lColNum) Then
bFlag = True
Exit For
End If
Next y
If Not bFlag Then
iDupes = 0
For y = x + 1 To lRows
If Cells(y, lColNum) = Cells(x, lColNum) Then
iDupes = iDupes + 1
End If
Next y
If iDupes > 0 Then
iColor = iColor + 1
If iColor > 56 Then
MsgBox "Too many duplicate companies!", vbCritical
Exit Sub
End If
Cells(x, lColNum).Interior.ColorIndex = iColor
For i = 1 To 5
Cells(x, lColNum + i).Interior.ColorIndex = iColor
Next i
For y = x + 1 To lRows
If Cells(y, lColNum) = Cells(x, lColNum) Then
Cells(y, lColNum).Interior.ColorIndex = iColor
For i = 1 To 5
Cells(y, lColNum + i).Interior.ColorIndex = iColor
Next i
End If
Next y
End If
End If
Next x
End Sub
Я отредактировал код, чтобы также изменить цвет горизонтальных линий на расстоянии до 5 ячеек от выбранной ячейки. Итак, что вы делаете, это выбираете все имена базы данных и затем запускаете макрос.