Contrôler si doublons dans une colonne

Bonjour,

Chose simple mais en tant que débutant en VBA, j'ai un peu de mal...

Je voudrais donc en VBA par lancement via bouton de contrôle

juste vérifier si au moins un doublon existe dans la colonne D à partir de D11

et afficher une MsgBox pour avertir l'utilisateur.

Merci pour votre aide.

Marcki

bonjour,

une solution possible en vba parmi de nombreuses autres

Option Explicit
Sub aargh()
    Dim dl As Long, i As Long, plage As Range, dict As Object
    Set dict = CreateObject("scripting.dictionary") 'dictionnaire contiendra la liste des doublons déjà détectés
    dl = Cells(Rows.Count, 4).End(xlUp).Row 'dernière ligne
    Set plage = Range("D11:D" & dl) 'plage de détection
    For i = 11 To dl 'on examine chaque ligne
        If Not dict.exists(Cells(i, 4).Value) Then 'déja détecté
            If Application.CountIf(plage, Cells(i, 4)) > 1 Then 'valeur présente plus d'une fois
                MsgBox "doublon détecté pour " & Cells(i, 4)
                dict(Cells(i, 4).Value) = 1
            End If
        End If
    Next i
End Sub

Bonjour

Un exemple trouvé sur le net

Slts et bon usage

Bonjour,

Un grand merci, le programme fonctionne parfaitement.

Par contre, je voudrais juste ajouter le lancement d'un Formulaire si pas de doublon.

en résumé :

si doublon -> msgbox (programme ci-dessous)

si pas de doublon : lancement du formulaire crée

ou dois je placer la ligne d'appel du formulaire ?

Merci d'avance pour votre aide.

Marcki

Option Explicit

Sub aargh()

Dim dl As Long, i As Long, plage As Range, dict As Object

Set dict = CreateObject("scripting.dictionary") 'dictionnaire contiendra la liste des doublons déjà détectés

dl = Cells(Rows.Count, 4).End(xlUp).Row 'dernière ligne

Set plage = Range("D11:D" & dl) 'plage de détection

For i = 11 To dl 'on examine chaque ligne

If Not dict.exists(Cells(i, 4).Value) Then 'déja détecté

If Application.CountIf(plage, Cells(i, 4)) > 1 Then 'valeur présente plus d'une fois

MsgBox "doublon détecté pour " & Cells(i, 4)

dict(Cells(i, 4).Value) = 1

End If

End If

Next i

End Sub

bonjour,

Option Explicit
Sub aargh()
    Dim dl As Long, i As Long, plage As Range, dict As Object
    Set dict = CreateObject("scripting.dictionary") 'dictionnaire contiendra la liste des doublons déjà détectés
    dl = Cells(Rows.Count, 4).End(xlUp).Row 'dernière ligne
    Set plage = Range("D11:D" & dl) 'plage de détection
    For i = 11 To dl 'on examine chaque ligne
        If Not dict.exists(Cells(i, 4).Value) Then 'déja détecté
            If Application.CountIf(plage, Cells(i, 4)) > 1 Then 'valeur présente plus d'une fois
                MsgBox "doublon détecté pour " & Cells(i, 4)
                dict(Cells(i, 4).Value) = 1
            End If
        End If
    Next i
    If dict.Count = 0 Then
    'lancer formulaire
    nomduformulaire.Show
    End If
End Sub

Un grand merci cela fonctionne parfaitement.

Marcki