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