Duplication enregistrement Access avec champs contenant plusieurs vale

Duplication enregistrement Access avec champs contenant plusieurs vale - VB/VBA/VBS - Programmation

Marsh Posté le 04-12-2008 à 20:31:59    

Bonjour,
 
je souhaiterais pouvoir dupliquer des lignes selon un champs comportant plusieurs valeurs.
 
exemple d'une ligne:
 
Colonne A (nom) : Dupont
Colonne B (prénom) : A
Colonne C (couleur) : rouge, vert, jaune
 
Je souhaiterais donc avoir 3 lignes :
 
Ligne 1 :
Colonne A (nom) : Dupont
Colonne B (prénom) : A
Colonne C (couleur) : rouge
 
Ligne 2 :
Colonne A (nom) : Dupont
Colonne B (prénom) : A
Colonne C (couleur) : vert
 
Ligne 3 :
Colonne A (nom) : Dupont
Colonne B (prénom) : A
Colonne C (couleur) : jaune
 
Quelqu'un aurait il une solution? (pour info je suis sous access 2003).
 
Merci d'avance.

Reply

Marsh Posté le 04-12-2008 à 20:31:59   

Reply

Marsh Posté le 06-12-2008 à 13:01:01    

En vba, c'est possible. Je te conseille néanmoins de passer par 3 tables :
- une table nom (tabNoms)
- une table couleur (tabCouleurs)
- une table liant les noms et les couleurs (tabRefNomsCouleurs)

 

Ensuite, parcourir la table de départ et pour chaque ligne, enregistrer le nom & prénom dans la table nom, ensuite pour chaque couleur dans le champ Couleurs, extraire le nom de la couleur, la stocker dans la table couleur si elle n'existe pas et compléter la table des relations Noms<->Couleurs
Ensuite, une requête (reqNomsCouleurs) permet d'afficher le résultat :

 

Voilà ce que ça donne :

 

J'ai nommé ta table "Originale" et complètée tel que tu donnais ton exemple : 3 champs : nom, prénom et couleurs, les couleurs étant séparées entre elles par des virgules.

 

http://img390.imageshack.us/img390/8687/accessqc5.gif
http://img390.imageshack.us/img390/accessqc5.gif/1/w980.png

 

Ne pas oublier de lier les tables entre elles en appliquant l'intégrité différentielle.

 

Ensuite, créer un module et faire le copier-collé du code ci-dessous (double clic dans la fenêtre du code ci-dessous pour enlever les numéros de lignes avant de faire le copier-coller ;) )

 
Code :
  1. Option Compare Database
  2. Option Explicit
  4. Sub toto()
  5. 'Déclaration des variables :
  6. 'Objet base
  7. Dim db As DAO.Database
  8. 'Objets tables
  9. Dim tabOri As DAO.TableDef
  10. Dim tabNom As DAO.TableDef
  11. Dim tabCou As DAO.TableDef
  12. Dim tabRel As DAO.TableDef
  13. 'Objets enregistrements
  14. Dim rstOri As Recordset
  15. Dim rstNom As Recordset
  16. Dim rstCou As Recordset
  17. Dim rstRel As Recordset
  18. 'Numériques entières
  19. Dim i As Integer
  20. Dim intIdNom As Integer 'Clé de la table tabNoms
  21. Dim intIdCou As Integer 'Clé de la table tabCouleurs
  22. 'Chaines de caractères
  23. Dim strChampCouleurs As String
  24. Dim strSep As String
  25. Dim strCar As String
  26. Dim strCouleur As String
  27. 'Variant
  28. Dim varCouleur As Variant
  30. 'Initialisation des variables :
  31. 'Base
  32. Set db = CurrentDb
  33. 'Tables
  34. Set tabOri = db.TableDefs("Originale" )
  35. Set tabNom = db.TableDefs("tabNoms" )
  36. Set tabCou = db.TableDefs("tabCouleurs" )
  37. Set tabRel = db.TableDefs("tabRefNomsCouleurs" )
  39. 'Parcours de la table "Originale"
  40. With tabOri
  41.     Set rstOri = .OpenRecordset
  42.     Set rstNom = tabNom.OpenRecordset
  43.     Set rstCou = tabCou.OpenRecordset
  44.     Set rstRel = tabRel.OpenRecordset
  45.    
  46.     'rstOri.MoveFirst
  47.    
  48.     'Pour chaque enregistrement de la table "Originale"
  49.     While Not rstOri.EOF
  50.         'Lecture du champ Nom et écriture de celui ci dans la table "tabNoms" :
  51.         rstNom.AddNew 'ouverture d'un enregistrement dans la table "tabNoms"
  52.         rstNom.Fields(1) = rstOri.Fields(0) 'Enregistrement du nom dans la table tabNoms
  53.         rstNom.Fields(2) = rstOri.Fields(1) 'Enregistrement du prénom dans la table tabNoms
  54.         intIdNom = rstNom.Fields(0) 'Clé de l'enregistrement créé
  55.         rstNom.Update 'Validation de l'enregistrement
  56.        
  57.         'Lecture du champ Couleurs
  58.         strChampCouleurs = rstOri.Fields(2)
  59.         'Il faut décomposer la ligne pour extraire chaque couleur
  60.         'Le nom des couleurs est séparé par des vigules
  61.         strSep = ","
  62.         strCouleur = ""
  63.         For i = 1 To Len(strChampCouleurs) + 1
  64.             strCar = Mid$(strChampCouleurs, i, 1)
  65.             'Dès qu'un séparateur ou que la fin de la chaine est détecté, chercher dans
  66.             'la table "tabCouleurs" si la couleur existe
  67.             If strCar = strSep Or i = Len(strChampCouleurs) + 1 Then
  68.                 varCouleur = DLookup("idCouleur", "tabCouleurs", "Couleur='" & Trim(strCouleur) & "'" )
  69.                 If Not IsNull(varCouleur) Then
  70.                     'Si la couleur est trouvée, alors inscrire la refCouleur dans la table relation
  71.                     rstRel.AddNew
  72.                     rstRel.Fields(1) = intIdNom 'Champs refIdNom
  73.                     rstRel.Fields(2) = varCouleur 'Champs refIdCouleur
  74.                     rstRel.Update 'Validation de la ligne
  75.                 Else
  76.                     'Sinon, inscrire la couleur dans la table couleur
  77.                     rstCou.AddNew
  79.                     rstCou.Fields(1) = Trim(strCouleur) 'Nom de la couleur sans espace dans le champ Couleur
  80.                     intIdCou = rstCou.Fields(0)
  81.                     rstCou.Update
  82.                     'et inscrire la refCouleur dans la table relation
  83.                     rstRel.AddNew
  84.                     rstRel.Fields(1) = intIdNom 'Champs refIdNom
  85.                     rstRel.Fields(2) = intIdCou 'Champs refIdCouleur
  86.                     rstRel.Update 'Validation de la ligne
  87.                 End If
  88.                 strCouleur = "" 'Effacement de la couleur en cours
  89.             Else
  90.                 strCouleur = strCouleur & strCar
  91.             End If
  92.            
  93.         Next i
  94.         'Ligne suivante dans la table "Originale"
  95.         rstOri.MoveNext
  96.     Wend
  97.    
  98. End With
  100. 'Fermeture des objets :
  101. 'recordsets
  102. Set rstOri = Nothing
  103. Set rstNom = Nothing
  104. Set rstCou = Nothing
  105. Set rstRel = Nothing
  106. 'Tables
  107. Set tabOri = Nothing
  108. Set tabNom = Nothing
  109. Set tabCou = Nothing
  110. Set tabRel = Nothing
  112. End Sub
 

Le code est commenté, ce qui m'évite de le faire maintenant !

 

C'est du code pour Access 97, je crois que pour 2003, il faut aussi insérer un gestionnaire d'erreur. A toi de le faire. Ce code fonctionne chez moi.

 

Trucs : tu peux changer le nom des tables pour mettre les tiens sur les lignes 34 à 37 et changer le caractère qui sépare le nom des couleurs à la ligne n°61 (variable strSep)

 

Résultat :
http://img257.imageshack.us/img257/4051/access1at5.gif
http://img257.imageshack.us/img257/access1at5.gif/1/w918.png

 

Bon courage :)


Message édité par otobox le 06-12-2008 à 13:10:53

---------------
OtObOxBlOg - - - Etre seul à avoir tort  c'est plus difficile, mais c'est bien plus beau que d'avoir raison avec une bande de cons
Reply

Marsh Posté le 06-12-2008 à 14:08:20    

Je vais tester tout ça, de plus cela me paraît très clair.
 
Un grand merci à toi!
 

Reply

Marsh Posté le 09-12-2008 à 15:37:05    

Bonjour
 
OtObOx C'est assez génial de voir des posts comme le tiens ! :jap:  
 
J'apporte juste ma petite contribution qui permet 'plus simplement', je pense, d'obtenir une table avec autant de lignes que de couleurs dans les enregistrements originaux.
 

Citation :

Function gramlinz60(NomDeTaTable, NomChamp_Nom, NomChamp_Prenom, NomChamp_Couleur) 'Le nom de ta table ou tu as tes lignes originales
                                                                                   'Les nom des champs Nom, Prenom et Couleur
     
    'On enleve les alertes sur requetes action
    DoCmd.SetWarnings False
     
    'On créer une variable pour les guillemets, plus facile pour les integrer dans une chaine de requete
    guil = Chr$(34)
     
    'On compte le nombre d'enregistrement dans ta table originale
    Set TableEnr = CurrentDb.OpenRecordset(NomDeTaTable)
    Cpte = TableEnr.RecordCount
 
    'on créé une table vierge avec Nom, Prenom et couleur
    Query = "SELECT " & guil & guil & " AS NomP, " & guil & guil & " AS PrenomP, " & guil & guil & " AS Couleur INTO MultiLigne;"
    DoCmd.RunSQL (Query)
    'on vide cette meme table
    Query = "DELETE MultiLigne.* FROM MultiLigne;"
    DoCmd.RunSQL (Query)
 
    'On se positionne sur le premier enregistrement de ta table originale
    TableEnr.MoveFirst
     
    'Pour chaque enregistrement on va ajouter une ligne avec la couleur dans la table créée
    For x = 1 To Cpte
         
        ValCouleur = TableEnr(NomChamp_Couleur)
        Ex = InStr(1, ValCouleur, "," )
         
         
        While Ex <> 0
            LaCouleur = Trim(Mid(ValCouleur, 1, Ex - 1))
             
            Query = "INSERT INTO MultiLigne ( NomP, PrenomP, Couleur ) SELECT " & guil & TableEnr(NomChamp_Nom) & guil & " AS Ex1, " & _
            guil & TableEnr(NomChamp_Prenom) & guil & " AS Ex2, " & guil & LaCouleur & guil & " AS Ex3;"
            DoCmd.RunSQL (Query)
             
            ValCouleur = Trim(Right(ValCouleur, Len(ValCouleur) - Ex))
            Ex = InStr(Ex, ValCouleur, "," )
         
        Wend
         
        Query = "INSERT INTO MultiLigne ( NomP, PrenomP, Couleur ) SELECT " & guil & TableEnr(NomChamp_Nom) & guil & " AS Ex1, " & _
        guil & TableEnr(NomChamp_Prenom) & guil & " AS Ex2, " & guil & ValCouleur & guil & " AS Ex3;"
        DoCmd.RunSQL (Query)
         
        TableEnr.MoveNext
    Next x
     
End Function


 
Je pars du principe que ta table originale se nomme 'Table', le champ nom 'Nom', le champ prénom 'Prenom' et le champ contenant les couleurs 'Couleur'
 
Pour lancer la fonction :

Citation :

gramlinz60 "Table", "Nom", "Prenom", "Couleur"


 
Résultat tu as une table nommée 'Multiligne' qui contient tes lignes avec une couleur a chaque fois.
 
C'est la virgule qui separe les couleurs.
 
Cordialement

Message cité 1 fois
Message édité par SuppotDeSaTante le 09-12-2008 à 15:41:31

---------------
Soyez malin, louez entre voisins !
Reply

Marsh Posté le 09-12-2008 à 18:26:07    

SuppotDeSaTante a écrit :

Bonjour
 
OtObOx C'est assez génial de voir des posts comme le tiens ! :jap:


 
Oué, merci :) je m'ennuyais samedi matin  :D  
 
J'avais répondu un peu à coté, dans la mesure où je ne sors pas une table mais 3 + 1 requête. Redondance toussa... C'est plus long, peut être qu'il y a moyen de faire un peu plus simple, mais c'est plus propre je trouve que de tout mélanger dans une seule table.  :)  
 


---------------
OtObOxBlOg - - - Etre seul à avoir tort  c'est plus difficile, mais c'est bien plus beau que d'avoir raison avec une bande de cons
Reply

Marsh Posté le 09-12-2008 à 22:48:44    

Ah oui c'est certain, mais ne sachant pas pourquoi c'etait faire, je me suis contenté de repondre a la question... :lol:


---------------
Soyez malin, louez entre voisins !
Reply

Marsh Posté le 11-12-2008 à 20:36:09    

Merci à vous deux.
 
J'ai utilisé la première méthodec d'otobox et cela a marché impec!
 
Merci !

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed