realçando linhas duplicadas no Excel pela macro VBA


-2

Eu tenho uma matriz que inclui valores diferentes / iguais na primeira coluna e valores diferentes na primeira linha.

Eu gostaria de comparar todas as linhas e destacar linhas duplicadas. Para cada linha, deve-se verificar a combinação dos valores “+”, “-“ e “/” e deve-se destacar os pares de linhas duplicados (triplos etc…) em cores diferentes (cores diferentes para cada par duplicado).

Deve também assumir que três linhas como abaixo são duplicatas.  Aceitará os valores “/” como “+” & amp; “-“ e irá destacar essas linhas também como duplicatas.

Aqui está um exemplo do resultado da macro que gostaria de ter (linhas da mesma cor são duplicadas); enter image description here

EDITAR: x4 & amp; x7 também são duplicados com x1 & amp; x2.E há outras duplicatas que eu não colorizei. Eu apenas colorizei algumas das duplicatas para explicar meu problema.


O que? "Aceitará os valores" / "como" + "& amp;" - "..." - não vejo nada de outros de “/”, “+” e “-”, então por que não todos as linhas consideraram o mesmo? E "row3 é uma duplicata de row3"? O que o seu pequeno bloco de texto significa? O texto vermelho significa alguma coisa?
G-Man

Editada a caixa de texto ... Fiz textos em vermelho para sublinhar que, para essas células, o valor "/" se comporta como "+" ou "-"
NT.

2
Eu não entendo seu sistema. Por exemplo x3 x9 parece ser o mesmo, assim como x4 x7 x8 x10 ainda não parece estar marcando definindo-os.
Ron Rosenfeld

sim você está certo, eu acabei de dar alguns exemplos. Eu não mencionei toda a mesa ...
NT.

Respostas:


2

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


1º de tudo, obrigado pelo código. Primeiro, inseri um módulo de classe e colei a primeira parte do código. Em seguida, inseri um módulo (regular) e colei a segunda parte do código. Finalmente, corri a macro selecionando a folha ativa com os dados a serem verificados. Eu me dá seguinte aviso ( imageshack.com/a/img913/3478/U6F1pV.jpg ) e abre o depurador. Eu faço sth. errado? Aqui está uma captura de tela da tela de depuração do código: imageshack.com/a/img661/6750/58Eka6.jpg Aqui estão os dados de amostra que eu corro a macro: imageshack.com/a/img631/4632/IPStdS.jpg
NT.

Você não renomeou o módulo de classe conforme instruído. Você parece ter duplicado o código do módulo de classe no módulo regular.
Ron Rosenfeld

Funciona como um charme após renomear o módulo de classe. Grande obrigado pelo código ...
NT.

@NT. Seja bem-vindo. E você pode modificá-lo facilmente para adicionar mais cores, se necessário. Você precisaria adicionar cores a arrColors e também alterar a linha K1 = J Mod 4 para algo como K1 = J Mod (Ubound(arrColors) + 1)
Ron Rosenfeld

Qual parte eu preciso editar para novas cores? @Ron Rosenfeld
NT.

1

Talvez concatene o conteúdo (col-F), conte as correspondências (col-G) e aplique um formato condicional baseado na quantidade de contagem.

Essa abordagem significa que dois conjuntos de linhas com a mesma quantidade de contagem terão a mesma cor.

XL count concatenate

XL conditional formatting


este método destaca apenas as linhas que são exatamente iguais. Não leva em conta que "/" deve ser assumido como "+" ou "-" durante a detecção de duplicados. Portanto, isso não resolve meu problema. Além disso, como é feito por formatação condicional e não por macro VBA, não é aplicável para mim.
NT.

+1 como esta é uma maneira criativa de fazer o que apareceu para ser o que ele estava procurando
James Mertz
Ao utilizar nosso site, você reconhece que leu e compreendeu nossa Política de Cookies e nossa Política de Privacidade.
Licensed under cc by-sa 3.0 with attribution required.