[Résolu]Empêcher l'enregistrement de doublons à partir d'une celulle

Lone-wolf

XLDnaute Barbatruc
Bonjour le Forum.

J'aimerais qu'à partir d'une celulle de la Feuil1, la saisie d'un même numéro soit interdite en affichant un Msg et celui-ci soit enregistrer dans la Feuil2; inclure un tri.
Note: les feuilles vont être renommées.

Exemple: Feuil1

En D4 je saisi le nom de la personne (Dupont)
En D5 le numéro de la fiche (1354)

Dans la Feuil2:

A1 30.10.11 (Date auto) - B1 Dupont - C1 1354

D'avance Merci.
 
Dernière édition:

job75

XLDnaute Barbatruc
Re : Empêcher l'enregistrement de doublons à partir d'une celulle

Bonjour Lone-wolf,

Un peu fainéant sur les bords n'est-ce pas, ça tombe bien moi aussi.

Pour interdire les doublons, utiliser la Validation de données avec NB.SI.

Ensuite pour copier les données d'une feuille à une autre, c'est archi classique, dans une macro Worksheet_Change.

A+
 

Lone-wolf

XLDnaute Barbatruc
Re : Empêcher l'enregistrement de doublons à partir d'une celulle

Bonjour Job,

j'ai déjà testé en suivant des exemples donnés sur le web, mais pour une seule feuille et sur une colonne et non une seule celulle. Et je n'arrive pas à faire la copie des données sur une autre feuille.

If Target.Value = "" Then Exit Sub

For Each cell In Intersect(UsedRange, Cells)
If cell.Address <> Target.Address And cell.Value = Target.Value Then
MsgBox "saisissez un autre numéro, celui-ci existe déjà"
Target.Value = ""
Target.Select
Exit For
End If
Next cell
End Sub

A+
 
Dernière édition:

Yaloo

XLDnaute Barbatruc
Re : Empêcher l'enregistrement de doublons à partir d'une celulle

Bonjour Lone-wolf, job75, le forum,

Avec ceci peut-être :

VB:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Count > 1 Then Exit Sub
If Target = [D5] Then
  If Application.WorksheetFunction.CountIf(Feuil2.Columns(2), Target.Value) = 1 Then
    MsgBox "Saisissez un autre numéro, celui-ci existe déjà"
    Target.Value = ""
    Target.Select
    Exit Sub
  Else
    l = Feuil2.Cells(65536, 1).End(xlUp).Row + 1
    Feuil2.Cells(l, 1) = [D4]
    Feuil2.Cells(l, 2) = [D5]
  End If
End If
End Sub

A mettre dans Feuil1
A+
Yaloo
 
Dernière édition:

Lone-wolf

XLDnaute Barbatruc
Re : Empêcher l'enregistrement de doublons à partir d'une celulle

En voici un autre de Silkyroads:

Code:
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim Colonne As Integer
    Dim Adresse As String
    
    'On sort si plus d'une cellule a été modifiée
    If Target.Count > 1 Then Exit Sub
    'On sort si la cellule modifiée est vide
    If Target.Value = "" Then Exit Sub
    
    'Définit la colonne à vérifier (1=Colonne A, 2=colonne B ...etc...)
    Colonne = 1
    
    'Vérifie si c'est la colonne cible a été modifiée
    If Target.Column = Colonne Then
    
        'Recherche si la nouvelle donnée existe déjà dans la colonne.
        Adresse = Columns(Colonne).Find(What:=Target.Value, After:=Target.Offset(1, 0), LookAt:=xlWhole, _
            SearchDirection:=xlNext).Address
            
        'Si l'adresse de cellule trouvée ne correspond pas à la cellule modifiée, cela
        'signifie qu'il y a un doublon dans la colonne.
        If Adresse <> Target.Address Then
        
            MsgBox "La donnée '" & Target & "' existe déjà dans la cellule " & Adresse
            'Suppression de la donnée
            Target.Value = ""
            Target.Select
        
        End If
    End If
  
End Sub

Mais c'est toujours pour une colonne.

Moi j'amerais obtenir ceci:

En D5 je tape 2457 et j'enregistre. Une autre personne retape en D5 2457 et la le message apparaît.
 

Yaloo

XLDnaute Barbatruc
Re : Empêcher l'enregistrement de doublons à partir d'une celulle

Oups j'avais oublié la date,

VB:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Count > 1 Then Exit Sub
If Target = [D5] Then
  If Application.WorksheetFunction.CountIf(Feuil2.Columns(2), Target.Value) = 1 Then
    MsgBox "Saisissez un autre numéro, celui-ci existe déjà"
    Target.Value = ""
    Target.Select
    Exit Sub
  Else
    l = Feuil2.Cells(65536, 1).End(xlUp).Row + 1
    Feuil2.Cells(l, 1) = Now
    Feuil2.Cells(l, 2) = [D4]
    Feuil2.Cells(l, 3) = [D5]
  End If
End If
End Sub

Yaloo
 
Dernière édition:

job75

XLDnaute Barbatruc
Re : Empêcher l'enregistrement de doublons à partir d'une celulle

Re, salut yaloo,

Au post #2 je parlais de validation de données, mais ce n'était pas vraiment une bonne idée.

Voyez le fichier joint avec ce code :

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lig&
If Intersect(Target, [D5]) Is Nothing Or IsEmpty([D5]) Then Exit Sub
If IsEmpty([D4]) Then MsgBox "Indiquez d'abord le nom...": _
  [D5] = "": [D4].Select: Exit Sub
With Feuil2 'CodeName
  If Application.CountIf(.[C:C], [D5]) Then MsgBox "Code déjà enregistré...": _
    [D5] = "": [D5].Select: Exit Sub
  lig = .[A65536].End(xlUp).Row + 1
  .Cells(lig, 1) = Date
  .Cells(lig, 2) = [D4]
  .Cells(lig, 3) = [D5]
  .[A:C].Sort .[B1], xlAscending, Header:=xlYes 'tri sur les noms
End With
End Sub
A+
 

Pièces jointes

  • Classeur(1).xls
    39.5 KB · Affichages: 56
  • Classeur(1).xls
    39.5 KB · Affichages: 62
  • Classeur(1).xls
    39.5 KB · Affichages: 70

Lone-wolf

XLDnaute Barbatruc
Re : Empêcher l'enregistrement de doublons à partir d'une celulle

Bonjour Yaloo,

avec le code donné, j'ai un problème concernant le nom de la personne qui saisi les numéros.
Les explication dans le poste #6.

Ex.: Dupond saisi en premier 6456, Durand saisi ensuite 6456 celui-ci s'inscrit quand même dans la feuille 2 et n'affiche pas de message.

A+
 

Lone-wolf

XLDnaute Barbatruc
Re : Empêcher l'enregistrement de doublons à partir d'une celulle

Oula! Super rapide Job!

C'est tout à fait ce que je voulais obtenir.

Merci infiniment, ceci était pour un programme du bouleau (où je fais le chameau...je bosse ;) ). On c'est aperçus que dans la liste il y avait deux fois le même numéro saisi avec des noms différents. C'est pour çela que j'ai fait appel au Forum.

Très bon weekend.
 

Yaloo

XLDnaute Barbatruc
Re : [Résolu]Empêcher l'enregistrement de doublons à partir d'une celulle

Re,

En rajoutant la date je n'ai pas décalé la colonne de recherche

VB:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Count > 1 Then Exit Sub
If Target = [D5] Then
  If Application.WorksheetFunction.CountIf(Feuil2.Columns(3), Target.Value) > 1 Then
    MsgBox "Saisissez un autre nom, celui-ci existe déjà"
    Target.Value = ""
    Target.Select
    Exit Sub
  Else
    l = Feuil2.Cells(65536, 1).End(xlUp).Row + 1
    Feuil2.Cells(l, 1) = Now
    Feuil2.Cells(l, 2) = [D4]
    Feuil2.Cells(l, 3) = [D5]
  End If
End If
End Sub

A+
 

job75

XLDnaute Barbatruc
Re : [Résolu]Empêcher l'enregistrement de doublons à partir d'une celulle

Re,

Un complément utile : quand on entre le nom en D4, le code en D5 s'efface (4ème ligne) :

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lig&
If Intersect(Target, [D4:D5]) Is Nothing Or IsEmpty([D5]) Then Exit Sub
If Not Intersect(Target, [D4]) Is Nothing Then [D5] = "": Exit Sub
If IsEmpty([D4]) Then MsgBox "Indiquez d'abord le nom...": _
  [D5] = "": [D4].Select: Exit Sub
With Feuil2 'CodeName
  If Application.CountIf(.[C:C], [D5]) Then MsgBox "Code déjà enregistré...": _
    [D5] = "": [D5].Select: Exit Sub
  lig = .[A65536].End(xlUp).Row + 1
  .Cells(lig, 1) = Date
  .Cells(lig, 2) = [D4]
  .Cells(lig, 3) = [D5]
  .[A:C].Sort .[B1], xlAscending, Header:=xlYes 'tri sur les noms
End With
End Sub
Fichier (2).

A+
 

Pièces jointes

  • Classeur(2).xls
    39.5 KB · Affichages: 57
  • Classeur(2).xls
    39.5 KB · Affichages: 64
  • Classeur(2).xls
    39.5 KB · Affichages: 60

Lone-wolf

XLDnaute Barbatruc
Re : [Résolu]Empêcher l'enregistrement de doublons à partir d'une celulle

Re job,

merci pour la modification.

Moi j'ai mis après End With:
[D4] = ""
[D5] = ""
Et modifier xlAscending par xlDescending, pour voir rapidement les dernières saisies éffectuées.

A+
 

job75

XLDnaute Barbatruc
Re : [Résolu]Empêcher l'enregistrement de doublons à partir d'une celulle

Re,

On peut aussi faire quelque chose de pas mal avec une validation de donnée en D5.

La macro est plus simple :

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lig&
If IsEmpty([D5]) Then Exit Sub
With Feuil2 'CodeName
  If IsEmpty([D4]) Or Not Intersect(Target, [D4]) Is Nothing Or _
    Application.CountIf(.[C:C], [D5]) Then [D5] = "": Exit Sub
  lig = .[A65536].End(xlUp).Row + 1
  .Cells(lig, 1) = Now 'date/heure
  .Cells(lig, 2) = [D4]
  .Cells(lig, 3) = [D5]
  .[A:C].Sort .[A1], xlDescending, Header:=xlYes 'tri sur date/heure
End With
End Sub
Fichier joint.

Nota : pas très partisant d'effacer D4 et D5 à la fin, car on ne voit pas ce qu'on a entré en D5...

A+
 

Pièces jointes

  • Classeur avec validation(1).xls
    40 KB · Affichages: 58
  • Classeur avec validation(1).xls
    40 KB · Affichages: 53
  • Classeur avec validation(1).xls
    40 KB · Affichages: 65
Dernière édition:

Lone-wolf

XLDnaute Barbatruc
Re : [Résolu]Empêcher l'enregistrement de doublons à partir d'une celulle

Re job,

Nota : pas très partisant d'effacer D4 et D5 à la fin, car on ne voit pas ce qu'on a entré en D5...

Cela dit ce n'est pas très grave, vu qu'on ne peut pas saisir deux fois les mêmes données.

Avec validation de données, j'ai fait ceci:

sélectionné D5 - VD - Personnalisé et rentré la formule.
J'ai le message d'erreur qui dit qu'on ne peut pas faire référence à une autre feuille.

A+
 

job75

XLDnaute Barbatruc
Re : [Résolu]Empêcher l'enregistrement de doublons à partir d'une celulle

RE,

Avec validation de données, j'ai fait ceci:

sélectionné D5 - VD - Personnalisé et rentré la formule.
J'ai le message d'erreur qui dit qu'on ne peut pas faire référence à une autre feuille.

Il n'y a pas ce problème sur Excel 2010.

Alors essayer en nommant la colonne C de la feuille Enregistrement.

A+
 

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 940
Membres
101 845
dernier inscrit
annesof