XL 2010 Doublon VBA

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

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.
 
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
 
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.
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
241
Réponses
4
Affichages
223
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
479
Réponses
4
Affichages
179
Réponses
7
Affichages
212
Réponses
3
Affichages
665
Retour