выделение повторяющихся строк в excel с помощью макроса VBA

У меня есть матрица, которая включает разные / одинаковые значения в первом столбце и разные значения в первой строке.

хотелось бы сравнить все строки и выделить повторяющиеся строки. Для каждой строки он должен проверять сочетание значений"+", " - " и " / " и выделять повторяющиеся пары строк(тройки и т. д.) разными цветами.(разные цвета для каждой пары дубликатов)

следует также предположить, что три строки, как показано ниже, являются дубликатами.  Он будет принимать "/" значения как " + " & " - " и он выделит эти строки также как дубликаты.

вот пример результата макроса, который я хотел бы иметь (строки одного цвета являются дубликатами) ;
enter image description here

изменить : x4 & x7 также дубликаты с x1 & x2.И есть другие дубликаты, которые я не раскрашивал. Я просто раскрасил некоторые дубликаты, чтобы объяснить свою проблему.

14
задан NT.
22.02.2023 14:32 Количество просмотров материала 3274
Распечатать страницу

2 ответа

Я хотел бы повторить свои правила соответствия следующим образом (Надеюсь, я прав):

  • + все матчи в класс [+/]
  • - все матчи в класс [-/]
  • / все матчи в класс [-+/]

учитывая это, речь идет о создании шаблона из конкатенации строк, который будет acta в качестве соответствующего шаблона. Это можно сделать с помощью регулярных выражений, но VBA имеет метод, который будет работать так же хорошо, возможно, быстрее.

мы устанавливаем вещи, сначала вставив модуль класса и переименовать его 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
отвечен Ron Rosenfeld 2023-02-23 22:20

возможно, объединить содержимое (col-F), подсчитать совпадения (col-G), а затем применить условный формат на основе количества подсчета.

этот подход означает, что два набора строк с одинаковым количеством qty будут иметь одинаковый цвет.

XL count concatenate



XL conditional formatting

1
отвечен Brad Smith 2023-02-24 00:37

Постоянная ссылка на данную страницу: [ Скопировать ссылку | Сгенерировать QR-код ]

Ваш ответ

Опубликуйте как Гость или авторизуйтесь

Имя
Вверх