Macro VBA pour passage en format BDD

Version imprimable

19/01/2011, 00h18
kimai

Macro VBA pour passage en format BDD

Bonjour,
Je possède une feuille de donnée excel organisée comme suit:
- Titres de colonnes sur la ligne 1
- Données à ne pas toucher de la colonne A à E
- Valeurs par mois sur les colonnes F,G,H et I
- Nombre de lignes variables

J'aimerais créer une macro qui transforme cette plage de données en une base de données.
Pour cela il faudrait que:
- les colonnes A à I ne changent pas
- les valeurs sur les colonnes F,G,H et I soient tous sur une même colonne unique, que j'appèlerai "Value"
- sur une nouvelle colonne, apparaisse les mois (qui étaient en fait les titres des colonnes F,G,H et I.)

Dans cette logique, sachant qu'il y a 4 colonnes (F,G,H et I) à modifier, les données qui se trouvent sur les colonnes A à E devraient être répliquées 4 fois.

J'espère avoir décrit suffisamment la "chose" pour que vous compreniez le principe.
Dans le cas contraire n'hésitez pas à me demander des infos complémentaires.

Merci bcp,
Julie
19/01/2011, 12h15
kimai

J'ai réussi à le faire via l'enregistreur de macro.
Le seul Hic c'est que le nombre de colonnes fixes, de colonnes variables et les lignes peuvent changer d'une semaine sur l'autre.

La macro enregistrée me donne le bon résultat mais seulement pour le nombre de colonnes variables et le nombre de lignes qu'il y avait lorsque que j'ai enregistrer la macro.

Si le nombre de lignes change ou le nombre de colonnes dites "variables" change, alors ma macro est inefficace...

Julie
19/01/2011, 17h59
Qwazerty

Salut
Une macro généré avec l'enregistreur n'a pas comme but d’être utilisé sans être retouché avent. L'enregistreur te fourni une base de code et te permet de déterminer des syntaxes, après il faut rajouter du code plus structuré.
Déposes ici ta macro et précises ou tu souhaites avoir des termes variables.
++
Qwaz

Merci de me venir en aide Qwazerty, je suis toute perdue là.

Tu trouveras ci-dessous le code généré par l'enregistreur de macro pour une plage de données avec 3 colonnes variables (pour simplifier car normalement j''en ai 14 ou15).

Pour bien t'expliquer la structure de mon fichier, mes données sont organisées comme suit:
- colonnes A à J = colonnes fixes
- colonnes K,L et M variables (données par mois que je veux mettre sous forme de BDD)
- ligne 1 avec le tritre des colonnes
- lignes 2 à 1111 avec mes données
--> à noter que les colonnes fixes, colonnes variables et nombres de lignes peuvent varier.

Je fais les manips suivantes avec l'enregistreur de macro
- je nomme la colonne N (1ere colonne libre) : "Value"
- Je nomme la colonne O (1Ere colonne libre) :"Period"
- Je sélectionne (K2:M1111) et je remplace toutes les cellules vides par un zéro

- Je copie (K2:K1111) et je le colle en (N2:N1111)
- Je copie (L2:L1111) et je le colle en (N1112:N2221)
- Je copie (M2:M1111) et je le colle en (N2222:N3331)

Je sélectionne (K1:M1) et je copie le contenue des 1Eres lignes sur toute la plage (donc jusqu'à la ligne 1111)
Puis
- Je copie (K2:K1111) et je le colle en (O2:O1111)
- Je copie (L2:L1111) et je le colle en (O1112:O2221)
- Je copie (M2:M1111) et je le colle en (O2222:O3331)

Je copie (A2;J1111) --> la plage de données relative à mes colonnes fixes et je la colle en:
- A1112
- A2222
(en fait je la colle "nombre de colonnes variables -1" fois)

Puis je supprime mes colonnes variables : K,L et M
Je reviens en cellule A1

Voici le code:

Code:

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
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
'
' Macrotestsimple Macro
'
 
'
    Selection.End(xlToRight).Select
    Range("N1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 16051415
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 1
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveCell.FormulaR1C1 = "Value"
    With ActiveCell.Characters(Start:=1, Length:=5).Font
        .Name = "Calibri"
        .FontStyle = "Regular"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .Color = -16777216
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Range("O1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 16051415
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 1
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveCell.FormulaR1C1 = "Period"
    With ActiveCell.Characters(Start:=1, Length:=6).Font
        .Name = "Calibri"
        .FontStyle = "Regular"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .Color = -16777216
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Range("J2").Select
    Selection.End(xlDown).Select
    Range("K1111:M1111").Select
    Range(Selection, Selection.End(xlUp)).Select
    Range(Selection, Selection.End(xlUp)).Select
    Range(Selection, Selection.End(xlUp)).Select
    Range(Selection, Selection.End(xlUp)).Select
    Range(Selection, Selection.End(xlUp)).Select
    Range(Selection, Selection.End(xlUp)).Select
    Range(Selection, Selection.End(xlUp)).Select
    Range(Selection, Selection.End(xlUp)).Select
    Range(Selection, Selection.End(xlUp)).Select
    Range(Selection, Selection.End(xlUp)).Select
    Range(Selection, Selection.End(xlUp)).Select
    Range(Selection, Selection.End(xlUp)).Select
    Range(Selection, Selection.End(xlUp)).Select
    Range(Selection, Selection.End(xlUp)).Select
    Range(Selection, Selection.End(xlUp)).Select
    Range(Selection, Selection.End(xlUp)).Select
    Range(Selection, Selection.End(xlUp)).Select
    Range(Selection, Selection.End(xlUp)).Select
    Range(Selection, Selection.End(xlUp)).Select
    Range(Selection, Selection.End(xlUp)).Select
    Range(Selection, Selection.End(xlUp)).Select
    Range("K2:M1111").Select
    Range("K1111").Activate
    Selection.Replace What:="", Replacement:="0", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("K2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Selection.End(xlToRight).Select
    Range("N2").Select
    ActiveSheet.Paste
    Range("L2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.End(xlToRight).Select
    Range("N2").Select
    Selection.End(xlDown).Select
    Range("N1112").Select
    ActiveSheet.Paste
    Selection.End(xlUp).Select
    Range("M2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.End(xlToRight).Select
    Selection.End(xlDown).Select
    Range("N2222").Select
    ActiveSheet.Paste
    Selection.End(xlUp).Select
    Range("K1:M1").Select
    Application.CutCopyMode = False
    Selection.AutoFill Destination:=Range("K1:M1111")
    Range("K1:M1111").Select
    Range("K2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Selection.End(xlToRight).Select
    Range("O2").Select
    ActiveSheet.Paste
    Range("L2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.End(xlToRight).Select
    Selection.End(xlDown).Select
    Range("O1112").Select
    ActiveSheet.Paste
    Selection.End(xlUp).Select
    Range("M2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.End(xlToRight).Select
    Selection.End(xlDown).Select
    Range("O2222").Select
    ActiveSheet.Paste
    Selection.End(xlUp).Select
    Range("A2:J2").Select
    Range("J2").Activate
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("J3").Select
    Selection.End(xlToLeft).Select
    Selection.End(xlDown).Select
    Range("A1112").Select
    ActiveSheet.Paste
    Selection.End(xlDown).Select
    Range("A2222").Select
    ActiveSheet.Paste
    Columns("K:M").Select
    Range("K2199").Activate
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Selection.End(xlToLeft).Select
    Selection.End(xlUp).Select
End Sub

C'est vraiment pas un cadeau je le sais, tu comprendras que je suis vraiment une débutante.. désolé pour ce code compliqué

Je comprendrais que ce soit trop long/compliqué à faire mais tous conseils sera bienvenus :oops:

20/01/2011, 12h32
Qwazerty

Salut
Une question, comment distingues tu les colonne fixent et variable, puisque visiblement d'un fichier a l'autre leur nombre varient.
Peux tu mettre un fichier exemple avec une feuille contenant les données "brut" et une 2eme feuille avec les données organisées comme tu le souhaites, ca sera plus simple a suivre je pense ;)
++
Qwaz
20/01/2011, 14h08
kimai

1 pièce(s) jointe(s)

Sachant que la 1ere colonne est toujours A et la premiere colonne varibale est toujours celle d'après la dernière fixe.
En fait idéalement il faudrait que je puisse spécifier la dernière colonne fixe.

Mais pour ne pas compliquer la chose on peut dire que les colonnes fixes sont de A à J et que les variables vont de K à ... ça peut varier en fait

Je te joins un fichier avec dans un onglet la donnée brute et dans l'autre le résultat voulu.

Si tu as besoin d'autres précisions n'hésite surtout pas :)

Salut
Essai avec ce code

Code:

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
Option Explicit
 
Sub test()
'On lance la cro de reorganisation en lui passant le nombre de colonnes fixes en parametre (ici 10 colonnes)
Reorganisation 10
End Sub
 
 
Sub Reorganisation(NbColFixes As Integer)
Dim NbColVariables As Integer
Dim NbLigneDonnee As Long
Dim Sh_Ori As Worksheet, Sh_Dest As Worksheet
Dim Rg_Donnee As Range
Dim i As Integer
 
 
'Initialisation des variables
Set Sh_Ori = ThisWorkbook.Sheets("Données brutes") 'a adapter
Set Sh_Dest = ThisWorkbook.Sheets("Feuil1") 'a adapter
'On determine le nombre de colonnes variable (nbr de colonnes totales - Nbr colonnes fixes)
NbColVariables = Sh_Ori.Cells(1, Columns.Count).End(xlToLeft).Column - NbColFixes
'On place les entêtes sur la feuile de destination
Sh_Ori.Range("A1").Resize(1, NbColFixes).Copy Sh_Dest.Range("A1")
Sh_Dest.Cells(1, NbColFixes + 1) = "Value"
Sh_Dest.Cells(1, NbColFixes + 2) = "Periode"
 
'On determine la zone de données contenues dans les colonnes fixes
Set Rg_Donnee = Sh_Ori.Range("A2", Sh_Ori.Cells(Rows.Count, NbColFixes).End(xlUp)) 'ici je suppose que la derniere colonne fixe n'a jamais de cellules vides, si ça n'estpas le cas préviens moi, on fera autrement
NbLigneDonnee = Rg_Donnee.Rows.Count
'on boucle autant de fois que de colonnes variables présentes
For i = 1 To NbColVariables
    'On va copier le contenu des colonnes fixes dans le nouveau classeur pour chaque periode
    With Sh_Dest
        Rg_Donnee.Copy .Range(Rg_Donnee.Address).Offset((i - 1) * NbLigneDonnee, 0)
        'On place les valeurs correspondante a la periode
        Sh_Ori.Range(Sh_Ori.Cells(2, NbColFixes + i), Sh_Ori.Cells(NbLigneDonnee + 1, NbColFixes + i)).Copy .Cells(NbLigneDonnee * (i - 1) + 2, NbColFixes + 1)
        'et la periodes correspondante
        .Range(.Cells(NbLigneDonnee * (i - 1) + 2, NbColFixes + 2), .Cells(NbLigneDonnee * (i - 1) + NbLigneDonnee + 1, NbColFixes + 2)).Value = Sh_Ori.Cells(1, NbColFixes + i).Value
    End With
 
Next
End Sub

J'ai réduit pas mal l'écriture, mais ça donne un code assez dense, si tu as besoin pour le comprendre n’hésites pas.
J'ai utiliser indifféremment copy ou des égalités de valeurs, se qui donne une mise en page hétérogène, il est possible de reprendre cette mise en page par la suite (couleur et trait)

++
Qwaz

Bonjour Julie et Quazerty,

Sans voir que Quaz avait répondu, j'ai travaillé de mon côté cet après midi et ce soir. Je me remet au vba pour Excel après une longue interruption et c'était un bon exercice pour moi. Le code précédent est bien plus compact (et donc bien meilleur).
Je poste le mien quand même car il reformate le tableau final indépendamment des formats initiaux (les lignes superflues étant particulièrement nombreuses avec l'enregistreur de macros pour les formats).
Et puis bon, faut bien que je montre que je me poule pas les rousses! :?
J'ai essayé de bien le documenter il y a quelques choix différents (inputbox par exemple pour l'entrée du nombres de colonnes fixes).
Pour comparer donc.

@Quaz : je ne connaissais pas Address et Resize, ça à l'air bien ! :ccool:

Cordialement.

R.

Code:

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
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
 
Option Explicit 'les variables doivent être obligatoirement déclarées
 
Sub Brutes_Voulu()
'A lancer en étant positionné sur la feuille contenant les données brutes
'Seul le tableau doit etre présent sur la feuille Données brutes
'(en particulier pas de cellules non vides sur la colonne 1 ou la ligne 1 au delà du tableau)
'Création d'une nouvelle feuille avec le résultat voulu
 
'déclaration des variables
Dim vColF As Byte 'nombre de colonnes fixes
Dim vLargI As Byte 'largeur du tableau initial
Dim vLargF As Byte 'largeur du tableau final
Dim vHauI As Long 'nombres de lignes du tableau initial
Dim oShtB As Worksheet 'feuille initiale
Dim oShtR As Worksheet 'feuille résultat
Dim oRngF As Range 'objet plage de cellules fixes
Dim oRngVb As Range 'objet plage de cellules fixes
Dim oRngVr As Range 'objet plage de cellules fixes
Dim vColV As Byte 'nombres de colonnes variables
Dim i As Integer 'compteur
 
'Routine d'erreur éventuelle
    On Error GoTo ErrTrp 'en cas d'erreur aller à ErrTrp:
 
'paramètres
    vColF = Application.InputBox(prompt:="Nombre de colonnes fixes ?", Type:=1) 'la valeur entrée doit être un nombre
    vLargI = Cells(1, Columns.Count).End(xlToLeft).Column 'la derniere cellule ligne 1 doit etre non vide
    vColV = vLargI - vColF 'déduction du nombres de colonnes variables
    'contrôle de cohérence : entrée manuelle
    If vColF >= vLargI Then
        MsgBox "Anomalie, la largeur du tableau n'est pas plus grande que le nombre de colonnes fixes"
        MsgBox "Fin du programme"
        Exit Sub
    End If
    vLargF = vColF + 2 'déduction de la largeur du tableau final
    vHauI = Cells(Rows.Count, 1).End(xlUp).Row 'la derniere cellule colonne 1 doit etre non vide
    'contrôle de cohérence : nombre de lignes
    If vHauI = 1 Then
        MsgBox "Anomalie, pas de lignes au tableau"
        MsgBox "Fin du programme"
        Exit Sub
    End If
    Set oShtB = ActiveSheet 'déclaration de la feuille active comme contenant le 'brut'
    Sheets.Add 'ajout d'une feuille
    Set oShtR = ActiveSheet 'déclaration de la feuille active comme contenant le résultat
 
'traitement
    oShtB.Activate 'activation feuille 'brute'
    'copie de la ligne de titre
    Set oRngF = oShtB.Range(Cells(1, 1), Cells(1, vColF)) 'déclaration de la plage ligne de titre (partie fixe)
    oRngF.Copy
    oShtR.Paste
    Application.CutCopyMode = False
        'titrage des 2 nouvelles colonnes
    oShtR.Cells(1, vColF + 1) = "Value"
    oShtR.Cells(1, vColF + 2) = "Period"
    'copie des lignes fixes
    Set oRngF = oShtB.Range(Cells(2, 1), Cells(vHauI, vColF)) 'déclaration de la plage fixe (corps du tableau)
    oShtR.Activate
    For i = 1 To vColV 'autant de collages que de colonnes variables
        oRngF.Copy oShtR.Range(Cells((vHauI - 1) * (i - 1) + 2, 1), Cells((vHauI - 1) * i + 1, 1)) 'copie de la plage fixe
        oShtB.Activate
        Set oRngVb = oShtB.Range(Cells(2, vColF + i), Cells(vHauI, vColF + i)) 'déclaration de la plage value au départ
        oShtR.Activate
        Set oRngVr = oShtR.Range(Cells((vHauI - 1) * (i - 1) + 2, vColF + 1), Cells((vHauI - 1) * i + 1, vColF + 1)) ''déclaration de la plage value à l'arrivée
        oRngVb.Copy oRngVr 'copie de la plage value
        oShtB.Cells(1, vColF + i).Copy oShtR.Range(Cells((vHauI - 1) * (i - 1) + 2, vColF + 2), Cells((vHauI - 1) * i + 1, vColF + 2)) 'copie de la plage period
    Next i
 
'formats
    oShtR.Activate
    'police
    Range(Cells(1, 1), Cells((vHauI - 1) * vColV + 1, vLargF + 2)).Font.Name = "Calibri"
    Range(Cells(1, 1), Cells((vHauI - 1) * vColV + 1, vLargF + 2)).Font.Size = 10
    Range(Cells(1, 1), Cells((vHauI - 1) * vColV + 1, vLargF + 2)).Font.FontStyle = "Normal"
    'fonds de cellules
    Range(Cells(1, 1), Cells(1, vColF)).Interior.Color = 14997432
    Range(Cells(2, vColF + 1), Cells((vHauI - 1) * vColV + 1, vColF + 1)).Interior.Color = 16775662
    Range(Cells(1, vColF + 2), Cells((vHauI - 1) * vColV + 1, vColF + 2)).Interior.Color = 16051415
    Range(Cells(2, 1), Cells((vHauI - 1) * vColV + 1, vColF)).Interior.Color = 16051415
    Cells(1, vColF + 1).Interior.Color = 16051415
    'bordures
    Range(Cells(1, 1), Cells(1, vColF + 2)).Borders.LineStyle = xlNone
    Range(Cells(2, 1), Cells((vHauI - 1) * vColV + 1, vColF + 2)).Borders.LineStyle = xlContinuous
    Range(Cells(2, 1), Cells((vHauI - 1) * vColV + 1, vColF + 2)).Borders.Weight = xlThin
    'alignements
    Range(Cells(1, vColF + 1), Cells((vHauI - 1) * vColV + 1, vColF + 2)).HorizontalAlignment = xlCenter
    Range(Cells(1, 1), Cells((vHauI - 1) * vColV + 1, vColF)).HorizontalAlignment = xlLeft
    Range(Cells(1, 1), Cells((vHauI - 1) * vColV + 1, vColF)).IndentLevel = 1
    'ajustement automatique
    For i = 1 To vColF + 2
        Cells(1, i).EntireColumn.AutoFit
    Next i
 
    GoTo Line1
 
ErrTrp: 'gestion des erreurs éventuelles
    Select Case Err.Number 'voir selon les cas rencontrés
        Case 1004 'on a entré "Annuler"
            MsgBox "Annulation"
        Case Else 'erreur non prévue, affiche la description et le n°
            MsgBox Err.Description & " n° " & Err.Number
            MsgBox "Fin du programme"
    End Select
 
    'libération des objets
Line1:
    Set oShtB = Nothing
    Set oShtR = Nothing
    Set oRngF = Nothing
    Set oRngVb = Nothing
    Set oRngVr = Nothing
 
End Sub

24/01/2011, 00h24
kimai

Wow 2 réponses différentes...
Quelle chance!
@Guy merci et ravie de pouvoir t'aider dans ta reconquête du VBA, si tu as besoin d'exercices je pense que tu peux tracker mes messages car je suis juste nulle :lol:

@Qwazerty, un super merci pour ta réponse, j'ai testé ce soir et ça marche nickel!

Je suis vraiment impressionnée.
Je vais vraiment essayer de comprendre ta macro pour en tirer des enseignements.

1000000 merci vraiment à tous les deux c'est trop mignon de votre part.

Bise
Julie :ccool:

Salut les amis,
J'ai voulu continuer sur la Macro de Qwaz (qui est géniale) pour ajouter quelques opérations supplémentaires mais je suis en train de tout détruire. :cry:

1- je voulais créer une nouvelle colonne appellée "Version", y mettre la formule "Today" en ligne 2 et étendre la formule jusqu'à la dernière ligne (qui peut varier)

Alors j'ai "codé" (lol):
Code:

1 2 Sh_out.Cells(1, NbColFixes + 3) = "Version" Sh_out.Cells(2, NbColFixes + 3) = "=TODAY()"
ça marche 8-)
Parcontre pour étendre la formule j'ai fait
Code:

1 2 Selection.AutoFill Destination:=Range(Cells(2, NbColFixes + 3), Cells(i, NbColFixes + 3)), Type:=xlFillDefault
Et là ça marche pas du tout!

2- Je voulais filtrer la dernière colonne fixe qui s'appelle "Datatype", c'est la 10eme colonne
Je voulais filtrer sur 4 critères seulement
J'ai fait un truc qui ressemble à ça et qui marche pas du tout
Code:

1 2 3 4 5 Range(Selection, Selection.End(xlToRight)).Select Selection.AutoFilter ActiveSheet.Range("$A$1:$M$16651").AutoFilter Field:=10, Criteria1:=Array( _ "crit1", "crit2", "crit3", _ "crit4"), Operator:=xlFilterValues
3- Je voulais aussi filtrer la colonne Sh_out.Cells(1, NbColFixes + 1) = "Value" en supprimant les "0" et "Blanks"

4-Enfin je voulais aussi sélectionner et copier toute la plage de données filtrées (Colonne A à dernière colonne (M) et toutes les lignes qui restent du filtre).
Idéalement il faudrait qu'au moment où je colle ces données (dans une table access), seules les lignes "filtrées" soient collées. Pas celles n'apparaissant pas dans le filtre.

Si une bonne âme pouvait m'aiguiller?

Et idéalement si quelqu'un pouvait me tuyauter sur un espèce de tuto VBA (de base) pour éviter que je vous pose des questions idiotes sur comment sélectionner une plage de données jusqu'à la dernière celulle ect... bah ça serait génial

Ju

Salut
Oula que de questions.
Pour les Tutos, regarde de ce coté là.

Il existe aussi un truc super pratique qui se nomme "Enregistreur de Macro", tu le trouvera dans l'onglet Développeur d'Excel, tu cliques sur le bouton, ça te demande un nom de macro(tu laisses par défaut) Valider. A partir de maintenant tout (ou presque) ce que tu fais est converti en code VBA, ça permet de connaitre la syntaxe a utiliser, tu pourras l'utiliser notamment pour ton problème de filtrage.

Alors pour la question 1:
L'utilisation de AutoFill ne me semble pas approprié, tu souhaites juste mettre la même valeur dans toutes tes cellule, donc tu pointes sur la plage de cellule et tu lui attribues une valeur via .Value. Toutes le cellule de la plage auront la même valeur.
Pour le "=Today()", je pense que tu souhaites mettre la date du jour ou tu exécute la macro et que celle ci reste toujours la même jusqu’à une nouvelle exécution? Si c'est ça, il ne faut pas mettre une formule avec Today(), mais juste la valeur du jour de l’exécution.
Si tu mettais Today dans ta cellule, à chaque lancement de ton fichier, la valeur de la cellule changerait pour prendre la date du jour de l'ouverture du fichier.

Voila une correction avec la colonne en plus
Code:

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 Sub Reorganisation(NbColFixes As Integer) Dim NbColVariables As Integer Dim NbLigneDonnee As Long Dim Sh_Ori As Worksheet, Sh_Dest As Worksheet Dim Rg_Donnee As Range Dim i As Integer 'Initialisation des variables Set Sh_Ori = ThisWorkbook.Sheets("Données brutes") 'a adapter Set Sh_Dest = ThisWorkbook.Sheets("Feuil1") 'a adapter 'On determine le nombre de colonnes variable (nbr de colonnes totales - Nbr colonnes fixes) NbColVariables = Sh_Ori.Cells(1, Columns.Count).End(xlToLeft).Column - NbColFixes 'On place les entêtes sur la feuile de destination Sh_Ori.Range("A1").Resize(1, NbColFixes).Copy Sh_Dest.Range("A1") Sh_Dest.Cells(1, NbColFixes + 1) = "Value" Sh_Dest.Cells(1, NbColFixes + 2) = "Periode" Sh_Dest.Cells(1, NbColFixes + 3) = "Version" 'On determine la zone de données contenues dans les colonnes fixes Set Rg_Donnee = Sh_Ori.Range("A2", Sh_Ori.Cells(Rows.Count, NbColFixes).End(xlUp)) 'ici je suppose que la derniere colonne fixe n'a jamais de cellules vides, si ça n'estpas le cas préviens moi, on fera autrement NbLigneDonnee = Rg_Donnee.Rows.Count With Sh_Dest 'on boucle autant de fois que de colonnes variables présentes For i = 1 To NbColVariables 'On va copier le contenu des colonnes fixes dans le nouveau classeur pour chaque periode Rg_Donnee.Copy .Range(Rg_Donnee.Address).Offset((i - 1) * NbLigneDonnee, 0) 'On place les valeurs correspondante a la periode Sh_Ori.Range(Sh_Ori.Cells(2, NbColFixes + i), Sh_Ori.Cells(NbLigneDonnee + 1, NbColFixes + i)).Copy .Cells(NbLigneDonnee * (i - 1) + 2, NbColFixes + 1) 'et la periodes correspondante .Range(.Cells(NbLigneDonnee * (i - 1) + 2, NbColFixes + 2), .Cells(NbLigneDonnee * (i - 1) + NbLigneDonnee + 1, NbColFixes + 2)).Value = Sh_Ori.Cells(1, NbColFixes + i).Value Next 'On rajoute ensuite la version en colonne NbColFixes + 3 'le nombre de ligne sur lequelles inscrire une valeur 'correspond à NbLigneDonnee * NbColVariables 'Soit '(ici je suppose que tu veux mettre la date du jour de l'execution de la macro ', par une formule qui change ferait apparaitre la date du jour a chaque ouverture de ton fichier?) .Range(.Cells(2, NbColFixes + 3)).Resize(NbLigneDonnee * NbColVariables, 1).Value = Date End With End Sub
Q2 & 3:
Sans connaitre les critères, ça n'est pas facile, essai de refaire ton code avec l'enregistreur de macro comme expliqué au début.

Q4:
Regarde dans l'aide Excel, tu as une méthode dans l'objet Range qui se nomme SpecialCell (un coup de F1 sur ce mot dans ton éditeur VBA), avec le bon paramètre tu sélectionneras uniquement les cellules visible.

Nota: Je vois que tu utilise Selection, évites au maximum l'utilisation des select, selection et activate. Défini les plage sur lesquelles tu veux travailler, je sais que ça parait fastidieux, mais si tu veux faire un truc stable avec lequel tu ne seras pas embêté dans le temps.... tu n'y couperas pas

++
Qwaz

1 pièce(s) jointe(s)

Bonjour Julie, bonjour Quaz,

Le code modifié pour les opérations demandées.

Je me suis (très largement :ccool:) inspiré du code de Quaz )avec Resize, Adress ;)) pour la partie traitement et ai optimisé mes rares petits 'plus' :
-Inputbox pour le nombres de colonnes fixes (évite d'ouvrir l'éditeur de macro en cas de nouvelle colonne fixe)
-Le classeur peut au départ ne contenir que la feuille 'Données brutes' sans aucune mise en forme, le formatage est inclus
-contrôles

La macro se termine par la copie des cellules visibles dans le presse papier mais je ne suis pas sur que l'on puisse coller directement dans access ensuite comme on le ferait dans word ou powerpoint par exemple. Si cette fonction devient inutile, la ligne

Code:

Range(oShtD.Cells(2, 1), oShtD.Cells((vRowO - 1) * vColOV + 1, vColD)).SpecialCells(xlCellTypeVisible).Copy

devient inutile. Il faudra peut être passer par ADO et SQL pour exporter vers Access. La base de donnée contient plusieurs tables ? Sinon il y aura surement plus souple. A voir.

Code:

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
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
Option Explicit
 
Sub MacroJ()
'! Pas de cellules vides dans la colonne 1 ou la ligne 1 du tableau
'! Pas de cellules non vides dans la colonne 1 ou la ligne 1 au delà du tableau
' conseil : laisser la colonne détail être la plus à droite des colonnes fixes et la colonne value la première des col variables en raison du param field du filtrage (moyennant quoi la macro restera fonctionnelle en cas d'ajout de colonnes fixes)
 
'déclaration tableau initial colonnes fixes et variables, tableau final colonnes
Dim vColOF As Byte, vColOV As Byte, vColD As Byte 'origine nb colonnes fixes et variables, destination nb colonnes
Dim vRowO As Long 'nb de ligne tableau d'origine
Dim oShtO As Worksheet, oShtD As Worksheet 'feuille d'origine et destinations
Dim oRngF As Range 'objet plage de cellules fixes
Dim i As Integer 'compteur
Const cDB = "Données brutes" 'nom de la feuille d'origine
 
'paramètres
    Set oShtO = Worksheets(cDB) 'feuille des données initiales
    vColOF = Application.InputBox(prompt:="Nombre de colonnes fixes ?", Type:=1, Default:=10)
    If vColOF = 0 Then Exit Sub 'sortie si click Annuler
    vColOV = oShtO.Cells(1, Columns.Count).End(xlToLeft).Column - vColOF 'la derniere cellule ligne 1 doit etre non vide
    'contrôle de cohérence de l'entrée vColOF
    If vColOV <= 0 Then
        MsgBox "Anomalie, la largeur du tableau n'est pas plus grande que le nombre de colonnes fixes"
        Exit Sub
    End If
    vRowO = oShtO.Cells(Rows.Count, 1).End(xlUp).Row - 1
    'contrôle de cohérence : nombre de lignes
    If vRowO = 0 Then
        MsgBox "Anomalie, pas de lignes au tableau"
        Exit Sub
    End If
    Sheets.Add 'ajout d'une feuille
    Set oShtD = ActiveSheet 'déclaration de la nouvelle feuille
    'nouvelles colonnes
    oShtD.Cells(1, vColOF + 1) = "Value"
    oShtD.Cells(1, vColOF + 2) = "Period"
    oShtD.Cells(1, vColOF + 3) = "Version"
    vColD = oShtD.Cells(1, Columns.Count).End(xlToLeft).Column
 
'traitement
    'ligne de titre
    oShtO.Range("A1").Resize(1, vColOF).Copy oShtD.Range("A1")
    'déclaration de la plage fixe (corps du tableau)
    Set oRngF = oShtO.Range("A2").Resize(vRowO, vColOF)
    'copie
    For i = 1 To vColOV 'autant de collages que de colonnes variables
        With oShtD
            oRngF.Copy .Range(oRngF.Address).Offset((i - 1) * vRowO, 0) 'copie de la plage fixe
            'copie valeurs
            Range(oShtO.Cells(2, vColOF + i), oShtO.Cells(vRowO + 1, vColOF + i)).Copy .Range(oShtD.Cells(vRowO * (i - 1) + 2, vColOF + 1), oShtD.Cells(vRowO * i + 1, vColOF + 1))
            'copie period
            oShtO.Cells(1, vColOF + i).Copy Range(oShtD.Cells(vRowO * (i - 1) + 2, vColOF + 2), oShtD.Cells(vRowO * i + 1, vColOF + 2))  'copie de la plage period
        End With
    Next i
    'date
    Range(oShtD.Cells(2, vColOF + 3), oShtD.Cells(vRowO * vColOV + 1, vColOF + 3)) = Date
 
 
'formats
    'police
    With Range(oShtD.Cells(1, 1), oShtD.Cells(vRowO * vColOV + 1, vColD)).Font
        .Name = "Calibri"
        .Size = 10
        .FontStyle = "Normal"
    End With
    'fonds
    Range(oShtD.Cells(1, 1), oShtD.Cells(1, vColOF)).Interior.Color = 14997432
    Range(oShtD.Cells(2, vColOF + 1), oShtD.Cells(vRowO * vColOV + 1, vColOF + 1)).Interior.Color = 16775662
    Range(oShtD.Cells(2, 1), oShtD.Cells(vRowO * vColOV + 1, vColOF)).Interior.Color = 16051415
    Range(oShtD.Cells(2, vColOF + 2), oShtD.Cells(vRowO * vColOV + 1, vColD)).Interior.Color = 16051415
    Range(oShtD.Cells(1, vColOF + 1), oShtD.Cells(1, vColD)).Interior.Color = 16051415
    'bordures
    Range(oShtD.Cells(1, 1), oShtD.Cells(1, vColOF + 2)).Borders.LineStyle = xlNone
    With Range(oShtD.Cells(2, 1), oShtD.Cells(vRowO * vColOV + 1, vColD)).Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    'alignements
    Range(oShtD.Cells(1, vColOF + 1), oShtD.Cells(vRowO * vColOV + 1, vColD)).HorizontalAlignment = xlCenter
    Range(oShtD.Cells(1, 1), oShtD.Cells(vRowO * vColOV + 1, vColOF)).HorizontalAlignment = xlLeft
    Range(oShtD.Cells(1, 1), oShtD.Cells(vRowO * vColOV + 1, vColOF)).IndentLevel = 1
    Range(oShtD.Cells(1, 1), oShtD.Cells(1, vColD)).EntireColumn.AutoFit 'ajustement
 
    'filtres
    Range(oShtD.Cells(1, 1), oShtD.Cells(1, vColD)).AutoFilter
    Range(oShtD.Cells(2, 1), oShtD.Cells(vRowO * vColOV + 1, vColD)).AutoFilter Field:=vColOF, Criteria1:=Array( _
        "yz1", "yz2", "yz3", "yz4"), Operator:=xlFilterValues 'critères à adapter
    Range(oShtD.Cells(2, 1), oShtD.Cells(vRowO * vColOV + 1, vColD)).AutoFilter Field:=vColOF + 1, Criteria1:="<>0", _
        Operator:=xlAnd, Criteria2:="<>"
    'copie des cellules visibles, la ligne de titre non inclue
    Range(oShtD.Cells(2, 1), oShtD.Cells((vRowO - 1) * vColOV + 1, vColD)).SpecialCells(xlCellTypeVisible).Copy
 
    'libération des objets
    Set oShtO = Nothing
    Set oShtD = Nothing
    Set oRngF = Nothing
 
End Sub

Je joint un fichier pour regarder sans aller tripatouiller dans le code original!

Amicalement

R

30/01/2011, 23h11
kimai

Bonsoir messieurs
Un grand merci pour vos réponses rapides et qui m'aident toujours autant.

Malheureusement je n'ai pu tester vos macros (arrêt de maladie) mais je promets de vous faire un retour dès que j'aurai accès à mes fichiers.

@Qwaz, j'utilise comme je peux l'enregistreur de macro mais je ne comprends pas toujours le code du 1er coup.
En tout cas je sens que ça vient tout doucement, surement à force de relire tes solutions.

A très vite pour un retour plus détaillé et merci encore messieurs

Ju
03/02/2011, 11h23
kimai

Bonjour messieurs
J'ai enfin repris le travail!

Pour répondre à vos questions concernant la date, en fait je sors le fichier une fois par semaine, donc la date du jour m'allait bien puisque je ne lançais pas la macro à postériori.

J'ai pu tester vos macros et apprécier qu'elle marchait vraiment bien.

Merci à toi Qwaz pour ta patience
La macro marche nickel sauf pour copier la cellule j'ai un bug au niveau de

Code:

.Range(.Cells(2, NbColFixes + 3)).Resize(NbLigneDonnee * NbColVariables, 1).Value = Date

Mais ne t'embete pas j'ai réussit en reprenant le code de GuyXL

@GuyXL: ta macro marche super et m'aide beaucoup, pour info j'arrive à copier le contenu sur access sans aucun problème ;)

Merci encore et encore à vous deux, vous êtes trop choux avec moi :oops:

Bise Ju