Macro pour éviter la saisie de doublons dans tout un classeur

[eperluette]

Modifier une macro pour éviter la saisie de doublons dans tout un classeur ?

Bonjour à tous !

J'ai fait une petite recherche sur le forum mais je ne crois pas avoir trouvé réponse à mon problème (et je m'en excuse car j'ai sûrement dû mal chercher !) 😱

Voilà, j'ai trouvé ici (pour rendre justice à son auteur !) une petite macro (que j'ai changée très légèrement) et qui marche très bien :

Private Sub Worksheet_Change(ByVal Target As Range)
Select Case Target.Value
Case "": Case Else
If Not Application.Intersect(Target, [A:A]) Is Nothing Then
Select Case Application.WorksheetFunction.CountIf([A:A], Target)
Case 1: Case Else
myMatch = Application.WorksheetFunction.Match(Target, [A:A], 0)
myPrompt = "Returns note below has already been entered in cell A" & myMatch & _
Chr(10) & "Please modify your entry"
myDefault = Target
myInput = InputBox(Prompt:=myPrompt, Default:=myDefault, Title:="Excel Tip")
Target = myInput
End Select
End If
End Select
End Sub

Cette macro permet d'empêcher la saisie de doublons dans une feuille donnée (pour la colonne A uniquement). Si l'utilisateur entre une donnée déjà présente, une fenêtre s'affiche indiquant l'adresse de la donnée déjà entrée et invitant à entrer une autre donnée.

En fait, j'aimerais savoir s'il est possible de modifier cette macro pour l'étendre au classeur entier ?

Si par exemple, je suis dans la feuille 2 et j'essaie de saisir une donnée déjà présente dans la feuille 1 (mais pas dans la 2), est-il possible d'avoir une macro qui me dise que la donnée a déjà été entrée dans la feuille 1, cellule tant ?

Euh voilà, j'espère que ce que je raconte n'est pas trop confus (pardonnez-moi, je débute !)

Merci beaucoup pour votre aide !!! 🙂

PS : je mets en pièce jointe mon fichier si besoin.

 

[XL_Luc]

Re : Macro pour éviter la saisie de doublons dans tout un classeur

Voici une solution mais j'ai pas optimisé (plante en cas de selection multiples ...)

Cette macro permet de ne pas saisir de doublons dans n'importe quelle feulle du classeur (à plasser dans l'objet thisworkbook)

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)


Select Case Target.Value
Case ""

Case Else

For i = 1 To ThisWorkbook.Sheets.Count
Select Case Application.WorksheetFunction.CountIf(Sheets(i).[A:IV], Target)
Case 0

Case 1
If Sheets(i).Name <> ActiveSheet.Name Then
GoTo a_modifier
End If

Case Else

GoTo a_modifier
End Select
Next
End Select

Exit Sub

a_modifier:

myPrompt = "Cette saisi a déjà été entrée "
myDefault = Target
myInput = InputBox(Prompt:=myPrompt, Default:=myDefault, Title:="Nouvelle saisie")
Target = myInput

End Sub

 

[eperluette]

Re : Macro pour éviter la saisie de doublons dans tout un classeur

Salut XL Luc,

Non non, ça fonctionne très bien chez moi ! Merci beaucoup pour ta réponse rapide 🙂

Par contre j'ai essayé de bricoler un peu le code pour pouvoir indiquer où est la cellule déjà entrée... Avec un bout de l'ancien code j'arrive à indiquer la cellule, mais pas la feuille, enfin ça donne ça :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Select Case Target.Value
Case ""
Case Else
For i = 1 To ThisWorkbook.Sheets.Count
Select Case Application.WorksheetFunction.CountIf(Sheets(i).[A:A], Target)
Case 0
Case 1
If Sheets(i).Name <> ActiveSheet.Name Then
GoTo a_modifier
End If
Case Else
GoTo a_modifier
End Select
Next
End Select
Exit Sub
a_modifier:
myMatch = Application.WorksheetFunction.Match(Target, [A:A], 0)
myPrompt = "Donnée déjà entrée en cellule A" & myMatch & _
Chr(10) & "Veuillez modifier votre saisie"
myDefault = Target
myInput = InputBox(Prompt:=myPrompt, Default:=myDefault, Title:="Excel Tip")
Target = myInput
End Sub

J'ai essayé de rajouter 'Sheet.Name' mais ça bloque 😀 Tu aurais une idée ?

Voilà en tout cas merci beaucoup pour ton aide jusqu'à présent 🙂

 

[XL_Luc]

Re : Macro pour éviter la saisie de doublons dans tout un classeur

et voilà avec identification :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)


Select Case Target.Value
Case ""

Case Else

For i = 1 To ThisWorkbook.Sheets.Count
Select Case Application.WorksheetFunction.CountIf(Sheets(i).[A:IV], Target)
Case 0

Case 1
If Sheets(i).Name <> ActiveSheet.Name Then
GoTo a_modifier
End If

Case Else

GoTo a_modifier
End Select
Next
End Select

Exit Sub

a_modifier:

        
        
myPrompt = "Cette saisi a déjà été entrée dans la feuille " & Sheets(i).Name & " Ligne " & Sheets(i).Cells.Find(What:=Target.Value, After:=Sheets(i).Cells(1, 1), LookIn:=xlValues, LookAt:= _
        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Row & " colonne " & Sheets(i).Cells.Find(What:=Target.Value, After:=Sheets(i).Cells(1, 1), LookIn:=xlValues, LookAt:= _
        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Column
        
myDefault = Target
myInput = InputBox(Prompt:=myPrompt, Default:=myDefault, Title:="Nouvelle saisie")
Target = myInput

End Sub

 

[eperluette]

Re : Macro pour éviter la saisie de doublons dans tout un classeur

Salut XL Luc,

Me revoilà après une longue absence ! J'ai essayé le nouveau code et ça fonctionne parfaitement !! C'est excatement ça que je cherchais. Je voulais juste te remercier une nouvelle fois, c'est vraiment sympa de ta part d'avoir pris le temps de me répondre.

Voilà, encore merci 🙂