Empecher un doublon

Résolu/Fermé
rodger85230 Messages postés 8 Date d'inscription lundi 20 mai 2019 Statut Membre Dernière intervention 11 juin 2021 - Modifié le 20 mai 2019 à 14:17
rodger85230 Messages postés 8 Date d'inscription lundi 20 mai 2019 Statut Membre Dernière intervention 11 juin 2021 - 6 juin 2019 à 19:08
Bonjour,
Configuration: Windows / Chrome 74.0.3729.157

j’ai récupéré une macro qui empêche les doublons sur la feuil1
mais pour moi il faut que cela soit sur deux feuilles (1 et 2)
et je n'y arrive pas voici le code
------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address <> "$D$1" Or Target.Count > 1 Then Exit Sub
   If Target = "" Then Exit Sub 'pour éviter des appels successifs
    Dim Dli As Long
  Dli = Cells(Rows.Count, 1).End(xlUp).Row
    If Application.CountIf(Range("A1:A" & Dli), Target) > 0 Then
    MsgBox Target & " est déjà dans la liste", vbInformation, "pas accepté :"
    Target = ""
  End If
  Target.Select
  End Sub


----------------------------------------
merci d'avance
**Modifié par la modération pour une lecture plus facile du code, à l'avenir utilisez les balises, VOIR CETTE PAGE
A voir également:

1 réponse

cs_Le Pivert Messages postés 7904 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 14 août 2024 729
Modifié le 20 mai 2019 à 15:40
Bonjour,

comme ceci:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address <> "$D$1" Or Target.Count > 1 Then Exit Sub
   If Target = "" Then Exit Sub 'pour éviter des appels successifs
    Dim Dli As Long
    Dim derniereLigne As Long
  Dli = Worksheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
  derniereLigne = Worksheets("Feuil2").Range("A" & Rows.Count).End(xlUp).Row
    If Application.CountIf(Range("A1:A" & Dli), Target) > 0 Or Application.CountIf(Worksheets("Feuil2").Range("A1:A" & derniereLigne), Target) > 0 Then
    MsgBox Target & " est déjà dans la liste", vbInformation, "pas accepté :"
    Target = ""
  End If
  Target.Select
  End Sub



0
rodger85230 Messages postés 8 Date d'inscription lundi 20 mai 2019 Statut Membre Dernière intervention 11 juin 2021
20 mai 2019 à 17:15
Bonjour et Merci
Votre réponse est la bonne , mais ma question n’était pas entière
serait'il possible que les dates qui s'inscrivent en feuil1 colonne A se retrouvent également sur la feuil2
merci d'avance
0
cs_Le Pivert Messages postés 7904 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 14 août 2024 729
20 mai 2019 à 18:10
Voilà:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Dli As Long
Dim derniereLigne As Long
If Not Intersect(Target, Range("A:A")) Is Nothing Then
 If Target = "" Then Exit Sub 'pour éviter des appels successifs
Worksheets("Feuil2").Range("A" & Target.Row) = Worksheets("Feuil1").Range("A" & Target.Row)
Worksheets("Feuil2").Range("A" & Target.Row).NumberFormat = "m/d/yyyy" 'a adapter le format
End If
If Target.Address <> "$D$1" Or Target.Count > 1 Then Exit Sub
  Dli = Worksheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
  derniereLigne = Worksheets("Feuil2").Range("A" & Rows.Count).End(xlUp).Row
    If Application.CountIf(Range("A1:A" & Dli), Target) > 0 Or Application.CountIf(Worksheets("Feuil2").Range("A1:A" & derniereLigne), Target) > 0 Then
    MsgBox Target & " est déjà dans la liste", vbInformation, "pas accepté :"
    Target = ""
  End If
  Target.Select
End Sub


@+ Le Pivert
0
rodger85230 Messages postés 8 Date d'inscription lundi 20 mai 2019 Statut Membre Dernière intervention 11 juin 2021
22 mai 2019 à 19:07
Bonjour
en fait je vais reprendre la première macro mais maintenant j'ai un autre problème c'est quand je lance une macro pour copier les données même si la date existe dans "histotest" colonne A, la macro (copie) me les copies . serait'il possible de rajouter dans cette macro de (copie) qu'il regarde si la date mise en colonne A "Donnée" est présente dans la colonne A dans "histotest" si oui avoir un message et stopper la macro ,si non que la macro continu pour la copie , voici la macro
Sub Copie()
If Sheets("Donnée").range("C3") = "" Then Exit Sub
Dim cDest As range
With Sheets("histotest")
Set cDest = .range("A" & Rows.Count).End(xlUp)(2)
cDest.Resize(, 6).Value = Array(range("c3").Value, range("c6").Value, range("c7").Value, range("c8").Value, range("c9").Value, range("c10").Value)
'Load UserForm1
'UserForm1.Show
Sheets("histotest").Select
End With

Merci d'avance
0
rodger85230 Messages postés 8 Date d'inscription lundi 20 mai 2019 Statut Membre Dernière intervention 11 juin 2021
6 juin 2019 à 19:08
Merci cs-picvert ne pas tenir en compte mon dernier message
ce que vous m'avez donné marche très bien
je marque comme résolue
0