Mysql
 sql >> Base de Dados >  >> RDS >> Mysql

Código de cores entradas duplicadas em um campo de um Excel usando cores alternadas


O processo que você está falando é chamado de 'duplicate banding'. Um par de Scripting.Dictionary objetos devem cuidar disso facilmente.
Sub colorDuplicateColor2()
    Dim d As Long, dODDs As Object, dEVNs As Object, vTMPs As Variant
    Dim bOE As Boolean
    
    Set dODDs = CreateObject("Scripting.Dictionary")
    Set dEVNs = CreateObject("Scripting.Dictionary")
    dODDs.CompareMode = vbTextCompare
    dEVNs.CompareMode = vbTextCompare
    
    With Worksheets("Sheet7")
        If .AutoFilterMode Then .AutoFilterMode = False
        
        With .Range(.Cells(1, "C"), .Cells(Rows.Count, "C").End(xlUp))
            
            With .Columns(1)
                .Cells.Interior.Pattern = xlNone
            End With
            
            With .Resize(.Rows.Count - 1, 1).Offset(1, 0)
                vTMPs = .Value2
            End With
            
            For d = LBound(vTMPs, 1) To UBound(vTMPs, 1)
                'the dictionary Items have to be strings to be used as filter criteria
                If Not (dODDs.exists(vTMPs(d, 1)) Or dEVNs.exists(vTMPs(d, 1))) Then
                    If bOE Then
                        dODDs.Item(vTMPs(d, 1)) = CStr(vTMPs(d, 1))
                    Else
                        dEVNs.Item(vTMPs(d, 1)) = CStr(vTMPs(d, 1))
                    End If
                    bOE = Not bOE
                End If
            Next d
            
            With .Columns(1)
                .AutoFilter Field:=1, Criteria1:=dODDs.Items, Operator:=xlFilterValues
                .SpecialCells(xlCellTypeVisible).Interior.Color = RGB(210, 210, 210)
                'use this to band the entire row
                '.SpecialCells(xlCellTypeVisible).EntireRow.Interior.Color = RGB(210, 210, 210)
                'use this to band the row within the UsedRange
                'Intersect(.Parent.UsedRange, .SpecialCells(xlCellTypeVisible).EntireRow).Interior.Color = RGB(210, 210, 210)
                .AutoFilter
                .AutoFilter Field:=1, Criteria1:=dEVNs.Items, Operator:=xlFilterValues
                .SpecialCells(xlCellTypeVisible).Interior.Color = RGB(255, 200, 200)
                .Cells(1).EntireRow.Interior.Pattern = xlNone
            End With
            
        End With
        
        If .AutoFilterMode Then .AutoFilterMode = False
    End With
    
    dODDs.RemoveAll: Set dODDs = Nothing
    dEVNs.RemoveAll: Set dEVNs = Nothing
    Erase vTMPs

End Sub

Os dados devem ser classificados na coluna de critérios duplicados, é claro.



Esse processo pode ser facilmente ajustado para faixas de linha completa ou linha dentro de bloco de dados.