Discussion :

[xycoco]

Bonjour,

Je pars d'une table FRANCE avec un champ NumRegion et des champs Année (de 2006 à 1900) soit une 100aines de colonnes. Chaque colonne contient des Notes.

Je souhaite obtenir une table "cible" issue d'une analyse "décroisée" avec 1 champ NumRegion , 1 champ année (qui se démultiplie), et 1 champ Note (valeur transposée).

J'ai travaillé sur le code de la FAQ,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
Private Sub Commande0_Click()
 
    Dim FRANCE As String
    Dim cible As String
    Dim nbfix As Integer
    Dim base As DAO.Database
    Dim champ As DAO.Field
    Dim depart As DAO.Recordset
    Dim departdef As DAO.Fields
    Dim boucle As Integer
    Dim typechamp As Integer
    Dim incohérent As Boolean
    Dim sql As String
    Dim sqlb As String
 
    Set base = CurrentDb()
    'If FRANCE = cible Then Exit Sub
    'ici la procédure s'arrête si la table source n'existe pas
    Set depart = base.OpenRecordset("FRANCE")
    Set departdef = base.TableDefs("FRANCE").Fields
    'vérification du nombre de champ à transposer
    If nbfix + 2 > departdef.Count Then
        MsgBox "il doit y avoir au moins deux champs à transposer", vbCritical, "ERREUR"
        Exit Sub
    End If
    'vérification du type des champs de source
    typechamp = departdef(nbfix).Type
    incohérent = False
    For boucle = nbfix + 1 To departdef.Count - 1
        Set champ = departdef(boucle)
        If champ.Type <> typechamp Then incohérent = True
    Next boucle
    If incohérent Then
        MsgBox "tous les champs transposés doivent avoir le même type", vbCritical, "ERREUR"
        Exit Sub
    End If
    'création de la table cible et ajout de la première colonne à transposer
    sql = "SELECT "
    For boucle = 0 To nbfix - 1
        sql = sql & departdef(boucle).Name & ","
    Next boucle
    sql = sql & "'" & departdef(nbfix).Name & "' as ipivot"
    sql = sql & ", " & departdef(nbfix).Name & _
        " as dpivot into " & "cible" & " from " & "FRANCE" & ";"
    Debug.Print sql
    DoCmd.RunSQL (sql)
    sql = "INSERT INTO " & "cible" & "("
    For boucle = 0 To nbfix - 1
        sql = sql & departdef(boucle).Name & ","
    Next boucle
    sql = sql & "ipivot,dpivot) SELECT "
    For boucle = 0 To nbfix - 1
        sql = sql & departdef(boucle).Name & ","
    Next boucle
    DoCmd.SetWarnings False
    'ajout des données suivantes
    For boucle = nbfix + 1 To departdef.Count - 1
        sqlb = sql & "'" & departdef(boucle).Name & "' as ipivot," _
             & "'" & departdef(boucle).Name & "' as dpivot FROM " & "FRANCE" & ";"
        DoCmd.RunSQL (sqlb)
    Next boucle
    DoCmd.SetWarnings True
 
End Sub

Selon la FAQ les 1ères colonnes spécifiées par nbfix restent inchangée; en l'occurence NumRegion. La colonne ipivot représente la colonne suivante à nbfix et qui reprend les intitulés des colonnes supérieures, soit ma colonne Année. La colonne dpivot contient les valeurs transposées, soit mes notes.

Mais je n'obtiens pas les résultats escomptés : j'ai une table assez bizarre avec 2 colonnes :
ipivot qui contient en valeur la légende "NumRegion" + mes intitulés Années
dpivot qui contient la valeur de NumRegion.

Pour mieux comprendre je joins la bd avec la table "cible" créée à partir du code (situé dans le formulaire1). La table Millésime montre ce que je souhaite obtenir en terme de résulats.

[xycoco]

J'avance dans mon problème :

1. La procédure était mal écrite et surtout mal appelée.
2. Mes entêtes (Année X) des champs de ma table à décroisé, me faisaient une erreur de syntaxe. Je les ai renommé par 2006, 2005, 2004 etc...

Voici mon code réparé :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
Sub anadecroise(source As String, cible As String, nbfix As Integer)
'cette procèdure crée une table cible
'à partir de la table source
' elle fait le travail inverse d'une requête analyse croisée
'les  premières colonnes spécifiées par nbfix restent inchangées
'la colonne (ipivot) suivante reprendra les intitulés des
' colonnes supérieures à nbfix
'la colonne suivante (dpivot) contient les valeurs transposées
'nb si on a des champs de type différents on fera tourner plusieurs fois la procédure en regoupant les champs de nature identique sur la partie droite de la table (en modification de table)
' à chaque itération cible deviendra source
Dim base As DAO.Database
Dim champ As DAO.Field
Dim depart As DAO.Recordset
Dim departdef As DAO.Fields
Dim boucle As Integer
Dim typechamp As Integer
Dim incohérent As Boolean
Dim sql As String
Dim sqlb As String
If source = cible Then Exit Sub
Set base = CurrentDb()
'ici la procédure s'arrête si la table source n'existe pas
Set depart = base.OpenRecordset(source)
Set departdef = base.TableDefs(source).Fields
'vérification du nombre de champ à transposer
If nbfix + 2 > departdef.Count Then
MsgBox "il doit y avoir au moins deux champs à transposer", vbCritical, "ERREUR"
Exit Sub
End If
'vérification du type des champs de source
typechamp = departdef(nbfix).Type
incohérent = False
For boucle = nbfix + 1 To departdef.Count - 1
Set champ = departdef(boucle)
If champ.Type <> typechamp Then incohérent = True
Next boucle
If incohérent Then
MsgBox "tous les champs transposés doivent avoir le même type", vbCritical, "ERREUR"
Exit Sub
End If
'création de la table cible et ajout de la première colonne à transposer
sql = "SELECT "
For boucle = 0 To nbfix - 1
sql = sql & departdef(boucle).Name & ","
Next boucle
sql = sql & "'" & departdef(nbfix).Name & "' as ipivot"
sql = sql & ", " & departdef(nbfix).Name & " as dpivot into " & cible & " from " & source & ";"
DoCmd.RunSQL (sql)
sql = "INSERT INTO " & cible & "("
For boucle = 0 To nbfix - 1
sql = sql & departdef(boucle).Name & ","
Next boucle
sql = sql & "ipivot,dpivot ) select "
For boucle = 0 To nbfix - 1
sql = sql & departdef(boucle).Name & ","
Next boucle
DoCmd.SetWarnings False
'ajout des données suivantes
For boucle = nbfix + 1 To departdef.Count - 1
sqlb = sql & "'" & departdef(boucle).Name & "' as ipivot," & departdef(boucle).Name & " as dpivot from " & source & ";"
DoCmd.RunSQL (sqlb)
Next boucle
DoCmd.SetWarnings True
End Sub

Que j'appelle par :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Private Sub Commande0_Click()
Call anadecroise("FRANCE", "resultat", 1)
End Sub

Il n'ya plus qu'un problème : dans le champs dpivot au lieu des notes cela m'affiche encore une 2ème fois les années???

Quelqu'un pourrait m'aider??

merci

[xycoco]

Je reviens à la charge.

Je pense que c'est un problème de format car si je mets une lettre au nom de mes champs Année (ex : A2006, A2005,...) : cela marche.

Bizarre

Pouvez-vous m'aider?

Merci

[xycoco]

J'ai trouvé. Il s'agit du format de même titre de champ et des valeurs de mes champs. Il suffit de mettre des crochets lorsque que l'on parle des valeurs des champs et des guillemets (chr(34)) pour les titres des champs :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
Sub anadecroise(Source As String, cible As String, nbfix As Integer)
       DoCmd.SetWarnings False
 
    Dim base As DAO.Database
    Dim champ As DAO.Field
    Dim depart As DAO.Recordset
    Dim departdef As DAO.Fields
    Dim boucle As Integer
    Dim typechamp As Integer
    Dim incohérent As Boolean
    Dim sql As String
    Dim sqlb As String
 
    If Source = cible Then Exit Sub
    Set base = CurrentDb()
    'ici la procédure s'arrête si la table source n'existe pas
    Set depart = base.OpenRecordset(Source)
    Set departdef = base.TableDefs(Source).Fields
    'vérification du nombre de champ à transposer
    If nbfix + 2 > departdef.Count Then
        MsgBox "il doit y avoir au moins deux champs à transposer", vbCritical, "ERREUR"
        Exit Sub
    End If
    'vérification du type des champs de source
    typechamp = departdef(nbfix).Type
    incohérent = False
    For boucle = nbfix + 1 To departdef.Count - 1
        Set champ = departdef(boucle)
        If champ.Type <> typechamp Then incohérent = True
    Next boucle
    If incohérent Then
        MsgBox "tous les champs transposés doivent avoir le même type", vbCritical, "ERREUR"
        Exit Sub
    End If
    'création de la table cible et ajout de la première colonne à transposer
    sql = "SELECT "
    For boucle = 0 To nbfix - 1
        sql = sql & departdef(boucle).Name & ","
    Next boucle
    sql = sql & Chr(34) & departdef(nbfix).Name & Chr(34) & " as [Annee]"
    sql = sql & ", [" & departdef(nbfix).Name & _
        "] as Notes into " & cible & " from " & Source & " WHERE [" & departdef(nbfix).Name & "] Is Not Null ;"
    Debug.Print sql
    DoCmd.RunSQL (sql)
    sql = "INSERT INTO " & cible & "("
    For boucle = 0 To nbfix - 1
        sql = sql & departdef(boucle).Name & ","
    Next boucle
    sql = sql & "Annee,Notes) select "
    For boucle = 0 To nbfix - 1
        sql = sql & departdef(boucle).Name & ","
    Next boucle
    DoCmd.SetWarnings False
    'ajout des données suivantes
    For boucle = nbfix + 1 To departdef.Count - 1
        sqlb = sql & Chr(34) & departdef(boucle).Name & Chr(34) & " as Annee,[" _
             & departdef(boucle).Name & "] as Notes from " & Source & " WHERE [" & departdef(boucle).Name & "] Is Not Null ;"
        DoCmd.RunSQL (sqlb)
    Next boucle
    DoCmd.SetWarnings False
 
End Sub