XL 2010 Doublon VBA

Franck74

XLDnaute Nouveau
Bonjour à la communauté,

Pour ce premier message, je souhaite savoir comment vérifier la saisie de doublons via du VBA.
J'ai un code pour cela (je ne l'ai pas créé, je l'ai trouvé sur le net) mais si il fait le job dans l'ensemble, je souhaite que le message d'erreur ne s'affiche qu'après le premier doublon repéré. Ici si j'ai des valeurs identiques dans deux cellules, il va m'afficher un MsgBox pour chacune des cellules. Je ne sais pas si cela est réalisable dans la mesure où je comprends bien pourquoi il m'affiche deux Msgbox...

VB:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Plage As Range
    Dim Cel As Range
 
    With Worksheets("Feuille 1")
 
 
    Set Plage = .Range(.Cells(2, 13), .Cells(.Rows.Count, 13).End(xlUp))
    End With
 
   For Each Cel In Plage
 
        If Application.CountIf(Plage, Cel.Value) > 1 Then
 
            MsgBox "Attention, la donnée '" & Cel.Value & "' est en doublon," _
                   & " veuillez vérifier que votre saisie située en '" & Cel.Address(0, 0) _
                   & "' est conforme au dossier client. "
 
            Cel.Interior.ColorIndex = 3
 
        End If
 
    Next Cel
 
    With Worksheets("Feuille 1")
 

       Set Plage = .Range(.Cells(2, 12), .Cells(.Rows.Count, 12).End(xlUp))
    
    End With
 
   For Each Cel In Plage
 
        If Application.CountIf(Plage, Cel.Value) > 1 Then
 
            MsgBox "Attention, la valeur '" & Cel.Value & "' est en doublon," _
                   & " veuillez resaisir le champ situé en '" & Cel.Address(0, 0) _
                   & "' avant de finaliser la saisie !"
 
            Cel.Interior.ColorIndex = 3
 
        End If
 
    Next Cel
    
    
End Sub
Merci pour vos remarques éclairées.
 

danielco

XLDnaute Occasionnel
Bonjour,

Essaie :

VB:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Plage As Range
    Dim Cel As Range
    With Worksheets("Feuille 1")
    Set Plage = .Range(.Cells(2, 13), .Cells(.Rows.Count, 13).End(xlUp))
   For Each Cel In Plage
        If Application.CountIf(.Range("M2", .Cells(Cel.Row, 13)), Cel.Value) = 2 Then
            MsgBox "Attention, la donnée '" & Cel.Value & "' est en doublon," _
                   & " veuillez vérifier que votre saisie située en '" & Cel.Address(0, 0) _
                   & "' est conforme au dossier client. "
        End If
      If Application.CountIf(Plage, Cel.Value) >= 2 Then
            Cel.Interior.ColorIndex = 3
      End If
    Next Cel
    End With
    With Worksheets("Feuille 1")
       Set Plage = .Range(.Cells(2, 12), .Cells(.Rows.Count, 12).End(xlUp))
    End With
   For Each Cel In Plage
        If Application.CountIf(Plage, Cel.Value) > 1 Then
            MsgBox "Attention, la valeur '" & Cel.Value & "' est en doublon," _
                   & " veuillez resaisir le champ situé en '" & Cel.Address(0, 0) _
                   & "' avant de finaliser la saisie !"
            Cel.Interior.ColorIndex = 3
        End If
    Next Cel
End Sub
Important : je n'ai modifié que pour la colonne M. Reporte les modifications pour la colonne L

Dans le code actuel, tu reçois autant de messages que tu as de doublons.

Cordialement.

Daniel
 

Franck74

XLDnaute Nouveau
Et je viens seulement de voir la fin de ton message danielco sur la modification de la colonne M... ^^
Super, c'est effectivement cela.
Ca me permet surtout de comprendre ce qui me gênait dans le code initial (la différence entre le =2 et le >1 si j'ai bien compris).

Merci beaucoup en tout cas danielco.
 

Discussions similaires


Haut Bas