Gostaria de reafirmar suas regras de correspondência da seguinte maneira (espero que esteja correto):
+
corresponde a qualquer coisa na classe [+/]
-
corresponde a qualquer coisa na classe [-/]
/
corresponde a qualquer coisa na classe [-+/]
Dado isso, é uma questão de criar um padrão a partir da concatenação de strings que atua como um padrão de correspondência. Isso pode ser feito usando expressões regulares, mas o VBA tem um método Like que funcionará tão bem, talvez mais rápido.
Nós configuramos as coisas primeiro inserindo um módulo de classe e renomeá-lo cRowString
Módulo de classe
Option Explicit
Private pRow As Long
Private pColA As String
Private pConcatString As String
Private pPattern As String
Public Property Get Row() As Long
Row = pRow
End Property
Public Property Let Row(Value As Long)
pRow = Value
End Property
Public Property Get ColA() As String
ColA = pColA
End Property
Public Property Let ColA(Value As String)
pColA = Value
End Property
Public Property Get ConcatString() As String
ConcatString = pConcatString
End Property
Public Property Let ConcatString(Value As String)
pConcatString = Value
End Property
Public Property Get Pattern() As String
Pattern = pPattern
End Property
Public Property Let Pattern(Value As String)
pPattern = Value
End Property
Em seguida, insira este Módulo Regular
Option Explicit
Sub HilightDuplicateRows()
Dim vData As Variant, lColors() As Long, V As Variant
Dim colDups As Collection
Dim R As Range
Dim cR As cRowString, colRows As Collection
Dim arrColors
Dim S1 As String, S2 As String
Dim I As Long, J As Long, K1 As Long, K2 As Long, L As Long
arrColors = VBA.Array(vbRed, vbCyan, vbYellow, vbGreen)
'get original range and load data into array
Set R = Range("a1", Cells(Rows.Count, "A").End(xlUp))
I = Cells(1, Columns.Count).End(xlToLeft).Column
Set R = R.Resize(columnsize:=I)
vData = R
'Iterate through and create patterns, collect them
Set colRows = New Collection
For I = 2 To UBound(vData, 1)
S1 = ""
S2 = ""
For J = 2 To UBound(vData, 2)
S1 = S1 & vData(I, J)
Select Case vData(I, J)
Case "+"
S2 = S2 & "[+/]"
Case "-"
S2 = S2 & "[-/]"
Case "/"
S2 = S2 & "[-+/]"
End Select
Next J
Set cR = New cRowString
With cR
.Row = I
.ColA = vData(I, 1)
.ConcatString = S1
.Pattern = S2
End With
colRows.Add cR
Next I
'Check for duplicate pairs
Set colDups = New Collection
For I = 1 To colRows.Count - 1
For J = I + 1 To colRows.Count
If colRows(I).ConcatString Like colRows(J).Pattern Then
colDups.Add CStr(colRows(I).Row & "," & colRows(J).Row)
End If
Next J
Next I
'Color the rows
ReDim lColors(1 To UBound(vData, 1))
J = 0
For I = 1 To colDups.Count
V = Split(colDups(I), ",")
If IsArray(V) Then
Select Case lColors(V(0))
Case 0
J = J + 1
K1 = J Mod (UBound(arrColors) + 1)
lColors(V(0)) = arrColors(K1)
lColors(V(1)) = arrColors(K1)
Case Else
lColors(V(1)) = lColors(V(0))
End Select
Else
lColors(V) = xlAutomatic
End If
Next I
R.Interior.Color = xlAutomatic
For I = 1 To R.Rows.Count
If lColors(I) = 0 Then
R.Rows(I).Interior.Color = xlAutomatic
Else
R.Rows(I).Interior.Color = lColors(I)
End If
Next I
End Sub
Selecione a planilha ativa e execute a macro