XL 2019 Eviter les doublons

[KHEROUBI]

Bonjour internautes
J'ai deux feuilles, une pour la saisie des données , l'autre pour enregistrer ces données.
1/ J'ai fais un petit programme pour éviter les doublons sur le numéro de la facture mais sa ne marche pas bien.
2/ et comment faire pour la même chose du numéro du BL.
Merci pour l'aide

 

[soan]

Bonjour KHEROUBI,

ton fichier en retour ; à toi de faire tous les tests.

code VBA du module de "Feuil1" :

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim adr$, k As Byte, ref$, cel As Range
  With Target
    If .CountLarge > 1 Then Exit Sub
    adr = .Address(0, 0)
    If adr = "A3" Then k = 1
    If adr = "C3" Then k = 2
    If k = 0 Then Exit Sub
    ref = .Value: If ref = "" Then Exit Sub
    Set cel = Worksheets("Données").Columns(k).Find(ref, , -4163, 1, 1)
    If cel Is Nothing Then Exit Sub
    MsgBox "le n° " & ref & " est déjà saisi.", 48, "pas accepté :"
    Application.EnableEvents = 0: .Value = ""
    Application.EnableEvents = -1
  End With
End Sub

code VBA de Module1 :

Option Explicit

Sub ajout_Facture()
  If ActiveSheet.Name <> "Saisie" Then Exit Sub
  Dim n&: Application.ScreenUpdating = 0
  With Worksheets("Données")
    With .ListObjects("Tableau1")
      If .DataBodyRange Is Nothing Then n = 0 Else n = .ListRows.Count
    End With
    With .Cells(n + 4, 1)
      .Value = [A3]        'N° BL
      .Offset(, 1) = [C3]  'N° Facture
      .Offset(, 2) = [E3]  'Date
      .Offset(, 3) = [G3]  'Montant
    End With
  End With
  [A3, C3, E3, G3].ClearContents
End Sub

si besoin, tu peux demander une adaptation.
à te lire pour avoir ton avis.

soan

 

[KHEROUBI]

Salut SOAN,
Ta solution travaille au merveille, mais il y a un petit changement : au lieu d'une seule feuille "Données" j'ai plusieurs feuilles (2 feuilles dans mon exemple). Quand je veux saisie des données je choisie un numéro de BC pour les affectés dans leurs Feuilles correspondante.
J'espère que je ne suis pas trop exigeant mais c'est un bon test pour moi.
Merci.
Mon fichier rectifié

 

[soan]

@KHEROUBI

tu as écrit : « Ta solution travaille à merveille »

merci pour le retour !

---

pour le petit changement, refais tous les tests avec le nouveau fichier joint.

code VBA du module de "Feuil1" :

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim adr$, k As Byte, ref$, cel As Range
  With Target
    If .CountLarge > 1 Then Exit Sub
    adr = .Address(0, 0)
    If adr = "A6" Then k = 1
    If adr = "C6" Then k = 2
    If k = 0 Then Exit Sub
    ref = .Value: If [B2] = "" Or ref = "" Then Exit Sub
    Set cel = Worksheets([B2]).Columns(k).Find(ref, , -4163, 1, 1)
    If cel Is Nothing Then Exit Sub
    MsgBox "le n° " & ref & " est déjà saisi.", 48, "pas accepté :"
    Application.EnableEvents = 0: .Value = ""
    Application.EnableEvents = -1
  End With
End Sub

code VBA de Module1 :

Option Explicit

Sub ajout_Facture()
  If ActiveSheet.Name <> "Saisie" Then Exit Sub
  If [B2] = "" Then Exit Sub
  Dim n&: Application.ScreenUpdating = 0
  With Worksheets([B2])
    With .ListObjects(1)
      If .DataBodyRange Is Nothing Then n = 0 Else n = .ListRows.Count
    End With
    With .Cells(n + 4, 1)
      .Value = [A6]        'N° BL
      .Offset(, 1) = [C6]  'N° Facture
      .Offset(, 2) = [E6]  'Date
      .Offset(, 3) = [G6]  'Montant
    End With
  End With
  [A6, C6, E6, G6].ClearContents
End Sub

la remarque suivante est valable pour les 2 subs : comme Saisie!B2 contient une validation de données avec liste, la feuille indiquée est censée toujours exister dans le classeur ; c'est pour ça que je n'ai pas mis de test pour vérifier l'existence de la feuille d'un Bon de Commande ; ni de On Error Resume Next ; par contre, on quitte la sub si Saisie!B2 est vide ; ce qui peut arriver si l'utilisateur a appuyé sur la touche Suppression ; or si B2 est vide, l'utilité de la sub devient sans objet :

* pour la 1ère sub, impossible de vérifier si la référence du Bon de Livraison ou du N° Facture existe déjà sur le Bon de Commande concerné.

* pour la 2ème sub, impossible d'ajouter une nouvelle ligne au Bon de Commande concerné.​

---

pour la 2ème sub : j'ai bien vu que le tableau structuré de la feuille "0325658" s'appelle "Tableau1" ; et le tableau structuré de la feuille "0325700" s'appelle "Tableau2".

* une 1ère solution serait de nommer le tableau structuré d'une feuille d'un Bon de Commande toujours avec le même nom : "Tableau1" ; on accéderait alors à ce tableau via :

Worksheets([B2]).ListObjects("Tableau1")

* si tu utilises des noms différents pour le tableau structuré d'une feuille d'un Bon de Commande, le plus simple est de faire comme j'ai fait : accéder au tableau structuré par son n° d'index :

Worksheets([B2]).ListObjects(1)

bien sûr, cela suppose qu'il y aie un seul tableau structuré sur la feuille ; ou s'il y en a plusieurs, qu'il soit toujours le 1er tableau structuré de la feuille.

* une autre solution serait d'accéder au tableau structuré par son nom, même s'il est différent d'une feuille Bon de Commande à une autre ; mais dans ce cas, il faudrait établir une correspondance entre le nom de la feuille et le nom du tableau structuré ; donc : "0325658" ➯ "Tableau1" ; "0325700"➯ "Tableau2" ; ou plus simplement : "0325658" ➯ N = "1" ; "0325700"➯ N = "2" suivi de :

Worksheets([B2]).ListObjects("Tableau" & N)​

---

si besoin, tu peux demander une adaptation.
à te lire pour avoir ton avis.

soan

 

[KHEROUBI]

Bonjour
Cher Soan je n'ai pas oublié ton post4 juste je l'ai reporté.
j'ai du mal a appliqué votre formule Worksheets([B2]).ListObjects("Tableau1") sur le module.
merci

 

[soan]

Bonsoir KHEROUBI,

désolé, y'a erreur de ma part : je croyais qu'on pouvait nommer un tableau structuré avec un nom déjà existant s'il est sur une autre feuille, mais non ; ça fait qu'il faut un nom différent pour chaque tableau structuré, même s'ils sont sur des feuilles différentes.

donc il faut utiliser Worksheets([B2]).ListObjects(1) ; OU établir une correspondance entre le nom de la feuille et le nom du tableau structuré.​

soan

 

[KHEROUBI]

Salut Soan
j'ai un problème c'est qu'il m'affiche

à chaque essai.

 

[soan]

@Kheroubi

* envoie-moi ton fichier actuel (sans données confidentielles)

* quelle est la sub qui provoque cette erreur ? Worksheet_Change() ?
ajout_Facture() ? une autre sub ?

* si c'est une sub Worksheet_Change(), de quelle feuille ?

* quelle ligne de code VBA est sur fond jaune ?

soan

 

[KHEROUBI]

salut Soan
voilà

kheroubi

 

[soan]

@Kheroubi

* c'est le fichier "CAS v2.xlsm" : ok

* c'est la sub Worksheet_Change() de la feuille "Saisie" : ok

* cette sub Worksheet_Change() est pour vérifier si, sur la feuille "Saisie", le N° BL que tu entres en A6 existe en colonne n° 1 (A) d'un Bon de Commande ; OU si le N° Facture que tu entres en C6 existe en colonne 2 (B) d'un Bon de Commande ; la ligne de code VBA initiale, qui marchait très bien, était celle-ci :

Set cel = Worksheets([B2]).Columns(k).Find(ref, , -4163, 1, 1)​

tu as modifié cette ligne de code VBA en :

Set cel = Worksheets([B2]).ListObjects(1)

pourquoi ?

à cette étape du code VBA, B2 ne peut pas être vide, car y'a juste au-dessus :

... : If [B2] = "" Or ref = "" Then Exit Sub

si B2 est vide, on quitte la sub ! alors qu'est-ce qu'il y a en B2 ? rappel :
y'a une validation de données de type Liste ; Source : =ListeBC

nom défini ListeBC : =Tableau3[N° BC]

c'est le tableau structuré de la feuille "Saisie", plage K2:K4

quand tu ajoutes un N° BC dans Tableau3, ça doit être le même que celui de l'onglet de la nouvelle feuille que tu as ajoutée pour un nouveau Bon de Commande !

peut-être que tu as oublié de taper l'apostrophe lors de la saisie ? comme quoi ce serait mieux que tu mettes le format Texte pour toutes les cellules de la colonne N° BC de Tableau3 ! si tu fais ça, ça ne sera plus la peine de taper l'apostrophe devant chaque N° BC que tu saisis. ​

---

si tu veux absolument utiliser Worksheets([B2]).ListObjects(1) :

en plus de ce que j'ai déjà écrit au-dessus du long trait de ce post : la nouvelle feuille ajoutée doit obligatoirement comporter un tableau structuré, comme pour les feuilles "0325658" et "0325700".

remarque : ma sub Worksheet_Change() initiale n'utilise pas ListObjects(1) ; elle fait une recherche en colonne A ou B de la feuille dont le nom est en B2.​

soan

 

[soan]

ATTENTION !

ce que j'ai marqué dans mon post #6 est UNIQUEMENT
pour la sub ajout_Facture() de Module1.

n'oublie pas de lire mon long post #10.

soan

 

[KHEROUBI]

Bonjour Soan
le problème est dans sub worksheets_change
quand je saisie dans le N° BL ou N° facture dans la feuille "Saisie" il m'affiche toujours

Kheroubi

 

[soan]

@KHEROUBI

comme tu as remis la bonne ligne de code VBA initiale, ça devrait marcher ! donc si ça plante, c'est à cause de ce qu'il y a sur la feuille "Saisie", cellule B2 ! le N° BC indiqué doit être le nom d'une feuille d'un Bon de Commande qui existe ; et si ton tableau structuré nommé "Tableau3" est correct, ça doit être ok ; pour pouvoir t'aider davantage, tu dois joindre ton fichier (sans données confidentielles).​

soan

 

[KHEROUBI]

Soan
Voilà le fichier que tu me la envoyé.

Kheroubi

 

[soan]

Bonsoir KHEROUBI,

ton fichier en retour ; problème réglé !

avec cette ligne de code VBA :

Set cel = Worksheets([B2].Value).Columns(k).Find(ref, , -4163, 1, 1)

j'ai juste ajouté .Value ➯ [B2].Value

---

d'autre part, pour que tu n'aies plus besoin de saisir un apostrophe devant une donnée de Tableau3, j'ai mis le format Texte en K3:K4 ➯ tu peux saisir 0325700 au lieu de '0325700 (ça sera idem pour les données que tu ajouteras dans ce tableau)​

soan