Recherche doublon plusieurs colonnes

Bonjour à tous,

Je vous expose mon problème:

j'ai un fichier Excel avec plus de 300 000 lignes, chaque ligne correspond aux coordonnées d'un employé. Une personne peut remplir jusqu'à 5 numéros de téléphone (numéro professionnel, numéro secrétariat, numéro service ,...). je cherche à mettre en évidence les doublons et compter le nombre de personnes qui ont renseigné plusieurs fois le même numéro sur leur ligne.

J'ai commencé à développer une macro, elle colorie bien ma première cellule quand elle trouve un doublon, mais les champs peuvent être vide et lorsque j'ai deux cases vides elle me compte un doublon (j'ai mis Is not Empty mais ça ne fonctionne pas).

Pouvez vous m'aider? voici mon code (attention je l'ai fait sur un fichier test, mes colonnes ne seront pas à côté dans le fichier Excel):

Je suis novice et mon code n'est peut être pas très propre, mais après de nombreuses recherche sur internet je n'ai pas trouvé de solution.

Sub comparaison()

Dl = Feuil1.Range("A30").End(xlUp).Row

For i = 2 To Dl

If Not IsEmpty(Range("A" & i)) And Range("A" & i) = Range("B" & i) Or Range("A" & i) = Range("C" & i) Or Range("A" & i) = Range("D" & i) Then

Range("A" & i).Interior.ColorIndex = 3

Else

Range("A" & i).Interior.ColorIndex = xlColorIndexNone

End If

If Not IsEmpty(Range("B" & i)) And Range("B" & i) = Range("C" & i) Or Range("B" & i) = Range("D" & i) Then

Range("A" & i).Interior.ColorIndex = 4

Else

End If

If Not IsEmpty(Range("C" & i)) And Range("C" & i) = Range("D" & i) Then

Range("A" & i).Interior.ColorIndex = 5

Else

End If

If Not IsEmpty(Range("D" & i)) And Range("D" & i) = Range("A" & i) Or Range("D" & i) = Range("B" & i) Or Range("D" & i) = Range("C" & i) Then

Range("A" & i).Interior.ColorIndex = 6

Else

End If

Next

End Sub

Merci par avance.

Bonjour,

Essaie comme cela

Sub Comparaison()
Dim DerLig As Long, Ligne As Long
Dim DerCol As Integer, Col As Integer
    With Worksheets("Feuil1")
        DerLig = .Range("A" & Rows.Count).End(xlUp).Row
        For Ligne = 2 To DerLig
            DerCol = .Cells(Ligne, Columns.Count).End(xlToLeft).Column
            For Col = 1 To DerCol
                If .Cells(Ligne, Col) <> "" And Application.CountIf(.Range(.Cells(Ligne, 1), .Cells(Ligne, DerCol)), .Cells(Ligne, Col).Value) > 1 Then
                    .Cells(Ligne, Col).Interior.ColorIndex = 3
                End If
            Next Col
        Next Ligne
    End With
End Sub

A+

Merci beaucoup. déjà je n'ai plus le problème des cases vides.

Par contre, comment je fais pour dissocier les colonnes, dans le code il compte les colonnes qui se suivent. Dans mon fichier, les colonnes de recherche des doublons seront en AW, BB, BG, BL et BQ.

Essaie comme cela

Sub Comparaison()
Dim DerLig As Long, Ligne As Long
Dim MaPlage As Range, C As Range, Cel As Range
    With Worksheets("Feuil1")
        DerLig = .Range("AW" & Rows.Count).End(xlUp).Row
        Set MaPlage = Application.Intersect(Application.Union(Columns("AW"), Columns("BB"), Columns("BG"), Columns("BL"), Columns("BQ")), Rows("2:" & DerLig))
        For Ligne = 2 To DerLig
            For Each C In MaPlage.Columns
                If .Cells(Ligne, C.Column) <> "" Then
                    For Each Cel In MaPlage.Columns
                        If .Cells(Ligne, C.Column).Address <> .Cells(Ligne, Cel.Column).Address And _
                        .Cells(Ligne, C.Column) = .Cells(Ligne, Cel.Column) Then
                            .Cells(Ligne, Cel.Column).Interior.ColorIndex = 3
                        End If
                    Next Cel
                End If
            Next C
        Next Ligne
    End With
End Sub

A+

Merci beaucoup, c'est exactement le résultat attendu !