XL 2016 doublons

[finarobert]

bonsoir
je possede un tableau excel qui comporte des caractères dans chaque cellule (du genre

>|Q8WZ42.4|TITIN_HUMAN.AltName: Full=Rhabdomyosarcoma antigen MU-RMS-40.14)

.Le nombre de lignes et de colonnes est variable d'un fichier à l'autre. J'aimerai repérer les doublons (ou plus) dans ce tableau et colorer les cellules correspondantes. Au mieux une couleur par doublon sinon une couleur globale. En langage VBA. Pouvez vous m'aider?
merci

 

[crocrocro]

Une remarque complémentaire :
Dans votre fichier, vous avez conservé les règles de Mise en forme Conditionnelle "doublons". A supprimer

 

[finarobert]

SUPER MERCI! me reste qu'il m'en manque 8. Je les trouve en manuel avec Rechercher mais pas par la macro. Bizarre, non?

 

[finarobert]

Votre fichier a des liens externes vers d'autres fichiers -> j'ai rompu les liens
J'ai lancé la macro depuis votre fichier :
L'erreur est due à la cellule T3 qui contient
Regarde la pièce jointe 1185568
Je l'ai vidé et continué le traitement _> tout est OK
A voir de votre côté pourquoi cette erreur en T13.

merci pour tout. Reste le problème qu'il m'en manque 8 que l'on trouve en manuel avec Recherche. Bizarre, non?

 

[crocrocro]

Quelles cellules ?
je me suis aperçu que mon code comportait une petite erreur pour les nuances de rouge.
Voici le nouveau code où le Range est nommé "TABLEAU2"

Sub Macro_Doublon()
' On met " couleur de fond ROUGE" les cellules en double du tableau
Dim NbDoublon As Integer
Dim Doublon As Boolean
Dim Fin As Boolean
Dim CouleurR As Integer
Dim CouleurV As Integer
Dim CouleurB As Integer
Dim CouleurInc As Integer
' On remet préalablement "sans couleur de fond" les cellules du tableau    Macro_Réinit_Doublon
    Macro_Réinit_Doublon
    
    With ActiveSheet
        NbDoublon = 0
        For Each cell In .Range("TABLEAU2")
            Doublon = False
            If Not (IsEmpty(cell)) Then
            ' on ne traite que les cellules non vides
                Fin = False
                For Each cell2 In .Range("TABLEAU2")
                    If (cell2.Value = cell.Value) And (cell.Address <> cell2.Address) And (Not Fin) Then
                        If (cell.Row < cell2.Row) Or ((cell.Row = cell2.Row) And (cell.Column < cell2.Column)) Then 'pour seulement les suivantes
                        ' apparemment les cellules sont balayées par ligne  colonne ( A2,B2 ... A3,B3 ...)
                            If Not Doublon Then
                                 'Nuance de rouge pour chaque groupe de doublon
                                Doublon = True
                                CouleurInc = Application.Min(255, NbDoublon * 20)
                                CouleurR = 255 - CouleurInc
                                CouleurV = CouleurInc
                                CouleurB = CouleurInc
                                NbDoublon = NbDoublon + 1
                            End If
                            With cell.Interior
                                .Pattern = xlSolid
                                .PatternColorIndex = xlAutomatic
                                .Color = RGB(CouleurR, CouleurV, CouleurB)
                                .TintAndShade = 0
                                .PatternTintAndShade = 0
                            End With
                            With cell2.Interior
                                .Pattern = xlSolid
                                .PatternColorIndex = xlAutomatic
                                .Color = RGB(CouleurR, CouleurV, CouleurB)
                                .TintAndShade = 0
                                .PatternTintAndShade = 0
                            End With
                        Else
                        'les précédentes, donc le doublon a déjà été constaté et la couleur positionnée
                            Fin = True
                        End If
                    End If
                Next
            End If
        Next

    End With

End Sub
Sub Macro_Réinit_Doublon()
'
' On remet "sans couleur de fond" les cellules du tableau
'
    With ActiveSheet
        For Each cell In .Range("TABLEAU2")
            With cell.Interior
                .Pattern = xlNone
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
        Next
    End With

End Sub

 

[finarobert]

Quelles cellules ?
je me suis aperçu que mon code comportait une petite erreur pour les nuances de rouge.
Voici le nouveau code où le Range est nommé "TABLEAU2"

Sub Macro_Doublon()
' On met " couleur de fond ROUGE" les cellules en double du tableau
Dim NbDoublon As Integer
Dim Doublon As Boolean
Dim Fin As Boolean
Dim CouleurR As Integer
Dim CouleurV As Integer
Dim CouleurB As Integer
Dim CouleurInc As Integer
' On remet préalablement "sans couleur de fond" les cellules du tableau    Macro_Réinit_Doublon
    Macro_Réinit_Doublon
   
    With ActiveSheet
        NbDoublon = 0
        For Each cell In .Range("TABLEAU2")
            Doublon = False
            If Not (IsEmpty(cell)) Then
            ' on ne traite que les cellules non vides
                Fin = False
                For Each cell2 In .Range("TABLEAU2")
                    If (cell2.Value = cell.Value) And (cell.Address <> cell2.Address) And (Not Fin) Then
                        If (cell.Row < cell2.Row) Or ((cell.Row = cell2.Row) And (cell.Column < cell2.Column)) Then 'pour seulement les suivantes
                        ' apparemment les cellules sont balayées par ligne  colonne ( A2,B2 ... A3,B3 ...)
                            If Not Doublon Then
                                 'Nuance de rouge pour chaque groupe de doublon
                                Doublon = True
                                CouleurInc = Application.Min(255, NbDoublon * 20)
                                CouleurR = 255 - CouleurInc
                                CouleurV = CouleurInc
                                CouleurB = CouleurInc
                                NbDoublon = NbDoublon + 1
                            End If
                            With cell.Interior
                                .Pattern = xlSolid
                                .PatternColorIndex = xlAutomatic
                                .Color = RGB(CouleurR, CouleurV, CouleurB)
                                .TintAndShade = 0
                                .PatternTintAndShade = 0
                            End With
                            With cell2.Interior
                                .Pattern = xlSolid
                                .PatternColorIndex = xlAutomatic
                                .Color = RGB(CouleurR, CouleurV, CouleurB)
                                .TintAndShade = 0
                                .PatternTintAndShade = 0
                            End With
                        Else
                        'les précédentes, donc le doublon a déjà été constaté et la couleur positionnée
                            Fin = True
                        End If
                    End If
                Next
            End If
        Next

    End With

End Sub
Sub Macro_Réinit_Doublon()
'
' On remet "sans couleur de fond" les cellules du tableau
'
    With ActiveSheet
        For Each cell In .Range("TABLEAU2")
            With cell.Interior
                .Pattern = xlNone
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
        Next
    End With

End Sub

MERCI POUR TOUT, TOUT EST OK!