☰

通过VBA宏突出显示Excel中的重复行

tag-icon • tag-icon microsoft-excel microsoft-excel-2010 macros duplicate
通过VBA宏突出显示Excel中的重复行

我有一个矩阵，其中第一列包含不同/相同的值，第一行包含不同的值。

我想比较所有行并突出显示重复行。对于每一行，它应该检查“+”、“-”和“/”值的组合，并且应该用不同的颜色突出显示重复的行对（三元组等）。（每个重复对使用不同的颜色）

它还应该假设下面三行是重复的。 它将接受“/”值作为“+”和“-”，并且它将突出显示这些行作为重复项。

这是我想要的宏结果的一个例子（相同颜色的行是重复的）； 在此处输入图片描述

编辑 ：x4 和 x7 也与 x1 和 x2 重复。还有其他重复项我没有上色。我只是为了解释我的问题而对一些重复项上色。

答案1

我将重申您的匹配规则如下（希望我是正确的）：

  • +匹配类中的任何内容[+/]
  • -匹配类中的任何内容[-/]
  • /匹配类中的任何内容[-+/]

鉴于此，问题在于从字符串连接中创建一个模式，该模式将充当匹配模式。这可以使用正则表达式来完成，但 VBA 有一个 Like 方法，它可以同样有效，甚至可能更快。

我们首先插入一个类模块并将其重命名为 cRowString

类模块

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

接下来输入这个常规模块

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

选择活动工作表并运行宏

答案2

也许连接内容（col-F），计算匹配数（col-G），然后根据计数数量应用条件格式。

这种方法意味着具有相同数量两个行集将具有相同的颜色。

XL 计数连接

XL 条件格式

相关内容