Empêcher les doublons dans une colonne

[PBI]

Bonjour à tous,

Est-il possible d’empêcher (via un message d’alerte) d’avoir une cellule avec le même contenu qu’une autre cellule dans la même colonne ?

Merci d’avance et belle journée.

PBI

[taz067]

Hello
un peu plus de precison et/ou un fichier pourrait mieux aider a te repondre, parce que en l’etat la reponse est " oui c’est possible"

[Cow18]

oui, c’est possible avec « validation »
PBI.xlsx (9,2 Ko)

[PBI]

Bonjour à tous,

J’ai encodé une VBA afin d’évite les doublons dans une colonne que voici :

Private Sub Worksheet_Calculate()

• Dim cell As Range*
• Dim cellValue As String*
• Dim count As Integer*
• Dim message As String*
• Dim rng As Range*
• ’ Définir la plage de cellules à surveiller (par exemple, colonne A)*
• Set rng = Me.Range(« W1:W1000 ») ’ Ajustez la plage selon vos besoins*
• ’ Parcourez chaque cellule de la plage*
• For Each cell In rng*

•    cellValue = cell.Value*
  

•    ' Ignore les cellules vides*
  

•    If cellValue <> "" Then*
  

•        ' Comptez les occurrences de la valeur dans la plage*
  

•        count = Application.WorksheetFunction.CountIf(rng, cellValue)*
  

•        ' Si plus d'une occurrence, affichez une alerte*
  

•        If count > 1 Then*
  

•            message = "Attention, l'équipe " & cellValue & " est déjà planifiée pour d'autres travaux à cette date"*
  

•            MsgBox message, vbExclamation*
  

•            Exit Sub*
  

•        End If*
  

•    End If*
  

• Next cell*
  End Sub

Et cela fonctionne !
Voyez vous une possibilité si je veux contrôler plusieurs colonnes, voire beaucoup de colonnes ?

Merci d’avance.

PBI

[Cow18]

comme ceci ?

Private Sub Worksheet_Change(ByVal Target As Range)
     Dim Isect As Range, c As Range

     Set c = Me.Range("D1:Z1000")            'la plage à tester
     Set Isect = Intersect(c, Target)        'les cellules qu'on a modifiées
     If Isect Is Nothing Then Exit Sub

     On Error GoTo ERR
     Application.EnableEvents = False        'arrêter les "events"
     For Each c0 In Isect.Cells              'traiter chaque cellule modifiée dans la plage àà tester
          If c0.Value <> "" Then             'cellule n'est pas vide
               If WorksheetFunction.CountIf(c.Columns(c0.Column - c.Column + 1), c0.Value) > 1 Then     'cellule n'est pas unique
                    MsgBox "Doublon " & c0.Address & "   " & c0.Value     'message
                    c0.ClearContents         'vider
               End If
          End If
     Next

ERR:
     Application.EnableEvents = True
End Sub