XL 2021 Identifier lignes des doublons dans message Box

[pierrof]

Bonjour à tous,

Suite à un nouveau projet, je souhaiterai faire apparaitre les numéros des lignes où se trouves les doublons dans une messagebox.

Exemples "Doublons ligne 12 et ligne 14"

J'ai un tableau de taille variable où les informations des doublons se situent sur la colonne B à partir de la 6ème ligne.

Je joins un fichier exemple pour plus de facilité.

Merci d'avance de votre aide.

Bonne journée

 

[piga25]

Bonjour pierrof,
Peut-être comme cela :

Private Sub CommandButton1_Click()
Dim i As Long
Dim j As Long
Dim lastRow As Long
Dim doublons As String
Application.ScreenUpdating = False
lastRow = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row

For i = 5 To lastRow
For j = i + 1 To lastRow
If Cells(i, 2).Value = Cells(j, 2).Value Then
doublons = doublons & "Ligne " & i & " et ligne " & j & vbCrLf
End If
Next j
Next i

If Len(doublons) > 0 Then
MsgBox "Les lignes suivantes contiennent des doublons :" & vbCrLf & doublons
Else
MsgBox "Aucun doublon trouvé."
End If

Application.ScreenUpdating = True
End Sub

 

[pierrof]

Salut piga25

C'est parfait, merci beaucoup

Bonne journée

 

[pierrof]

Bonjour à tous,

J'aimerais apporter une évolution à ce code d'identification des doublons. En effet ce code ne tiens compte de la casse.
JE souhaite qu'il puisse me dire qu'il y a des doublons malgré les majuscules ou minuscule...

Merci

Bonne journée

 

[patricktoulon]

bonjour

Private Sub CommandButton1_Click()
    Dim i As Long
    Dim j As Long
    Dim lastRow As Long
    Dim doublons As String
    Application.ScreenUpdating = False
    lastRow = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row

    For i = 5 To lastRow
        For j = i + 1 To lastRow
            If UCase(Cells(i, 2).Value) = UCase(Cells(j, 2).Value) Then
                doublons = doublons & "Ligne " & i & " et ligne " & j & vbCrLf
            End If
        Next j
    Next i

    If Len(doublons) > 0 Then
        MsgBox "Les lignes suivantes contiennent des doublons :" & vbCrLf & doublons
    Else
        MsgBox "Aucun doublon trouvé."
    End If

    Application.ScreenUpdating = True
End Sub

 

[pierrof]

Bonjour patricktoulon,

Merci ça fonctionne.

Bonne journée

Cordialement