[XL-2003] Alimentaion des feuilles depuis occurences sur feuille de synthèse

[MarcelG]

Bonjour le Forum,

Cette demande est récurrente.
Elle consiste à disposer d’un code qui, à partir d’une colonne appartenant à une feuille de synthèse, crée autant de feuilles que d’occurrences appartenant à celle-ci. Chaque feuille est alimentée par les données extraites de la feuille de synthèse.
Dès lors, 2 problématiques peuvent se poser.
- la liste des occurrences
- l’alimentation des feuilles
La performance des variables tableau n’est certes plus à démontrer. Cette méthode est donc la plus adaptée pour l’alimentation des feuilles.
En ce qui concerne les occurrences, là encore 2 possibilités :
- la méthode collection
- la méthode dictionnaire
Le processus envisagé dans le code proposé se décompose ainsi :
- choix de la colonne par Inputbox, en lettres ou en nombre (conversion par fonction si lettre(s)) (1)
- création de la liste des occurrences par collection ou dictionnaire (triés, pour le fun)
- création des feuilles correspondantes
- alimentation des variables tableau par la méthode Find (Comme d’autres les chauves-souris, « J’aime paaaas » les balayages)
- transposition des données dans la feuille correspondante

(1) Il me pardonnera, je l’espère, j’ai passé outre la remarque – judicieuse par ailleurs – de Didier dans son intéressant tutoriel sur les saisies numériques obligatoires. J’ai donc utilisé la propriété « Isnuméric ».

Je tiens à préciser que je ne suis pas le développeur de toutes les fonctionnalité ici présentées (Merci à Silkyroad, notamment). Mon objectif était de les lier pour aboutir au résultat recherché.

J’espère sincèrement l’utilité de ce développement. Mais je n’en attends pas moins vos remarques constructives qui permettront de l’améliorer.

Par avance, Merci à tous.

Marcel

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
Option Explicit
Option Compare Text
 
Dim numcol As Integer
Dim liste As Range
 
'-----------------------------------------------------------------------------------------------------CHOX DE LA COLONNE---------------------------------------------------------------------------------------------------
 
Sub Crée_Feuiles()
 
    Dim dercel As Range
    Dim choix_col As Variant
 
    'Choix de la colonne de la feuille de Synthèse contenant les occurences
    choix_col = InputBox("Entrer la colonne où se trouvent les occurences des feuilles à créer." & Chr(10) & "En lettres ou en chiffres (exemple ""AM"" ou 3).", "Colonnes choisie")
    numcol = IIf(IsNumeric(choix_col), choix_col, Colnuméric(choix_col))
 
    'Définition de l'adresse contenant toutes les occurences
    With Sheets("Synth")
            Set dercel = .Cells(.Rows.Count, numcol).End(xlUp)
            Set liste = .Range(.Cells(2, numcol), dercel)
    End With
 
    'Création des Feuilles pour chaque occurence
    Call Creer_Liste_Feuilles(liste)
 
    'Réinitialisation des variables
    Set dercel = Nothing
    Set liste = Nothing
 
End Sub
 
'-----------------------------------------------------------------------------------------------------CREATION LISTE PAR COLLECTION---------------------------------------------------------------------------------------------------
 
Sub Creer_Liste_Feuilles(Plage As Range)
 
Dim Cell As Range
Dim Un As Collection
Dim i As Long, j As Long
Dim Inverse1, Inverse2, Item
 
Set Un = New Collection
 
On Error Resume Next
 
'Boucle sur la plage de cellule
For Each Cell In Plage
        'If Cell <> "" Permet de ne pas prendre en compte les cellules vides
        'Un.Add Cell, CStr(Cell) Ajoute le contenu de la cellule dans la collection
        If Cell <> "" Then Un.Add Cell, CStr(Cell)
Next Cell
 
On Error GoTo 0
 
'Tri de la collection
For i = 1 To Un.Count - 1
        For j = i + 1 To Un.Count
                If Un(i) > Un(j) Then
                        Inverse1 = Un(i)
                        Inverse2 = Un(j)
                        Un.Add Inverse1, before:=j
                        Un.Add Inverse2, before:=i
                        Un.Remove i + 1
                        Un.Remove j + 1
                End If
        Next j
Next i
 
'Boucle sur les éléments de la collection et création de la feuille correspondante.
For i = 1 To Un.Count
        Call Gestion_Feuilles(Un(i))
Next i
 
Set Un = Nothing
 
End Sub
 
'-----------------------------------------------------------------------------------------------------CREATION DE LA FEUILLE SI ELLE N'EXISTE PAS---------------------------------------------------------------------------------------------------
 
Public Sub Gestion_Feuilles(occurs As String)
 
Dim i As Integer, n As Integer, nbcol As Integer
Dim f As Range, celcop As Range
Dim firstAddress As String
Dim Tablo() As Variant
Dim sh As Worksheet
Dim existe_feuil As Boolean
 
Application.ScreenUpdating = False
 
'Ligne de titre
With Sheets("Synth")
        Set celcop = .Range("A1", .Cells(1, .Columns.Count).End(xlToLeft))
End With
 
'Nombre de données à alimenter = dimension 1 de la variable Tablo
nbcol = celcop.Columns.Count
 
'Test si la feuille existe
existe_feuil = False
For Each sh In Worksheets
        If sh.Name = occurs Then
                existe_feuil = True
                Exit For
        End If
Next sh
 
'Si la feuille n'existe pas, alors création de celle-ci avec nom et titres de colonnes adaptés
If existe_feuil = False Then
        Sheets.Add Type:=xlWorksheet, After:=Sheets(Sheets.Count)
        celcop.Copy
        With ActiveSheet
                .Paste Destination:=.Range("A1")
                .Name = occurs
        End With
        Application.CutCopyMode = False
End If
 
'Alimentation de la variable Tablo
With liste
    Set f = .Find(occurs, LookIn:=xlValues)
    If Not f Is Nothing Then
        firstAddress = f.Address
        Do
                n = n + 1
                ReDim Preserve Tablo(1 To nbcol, 1 To n)
                'Toutes les cellules de la ligne alimentent Tablo
                For i = 1 To nbcol
                        Tablo(i, n) = f.Offset(0, i - numcol)
                Next i
                Set f = .FindNext(f)
        Loop While Not f Is Nothing And f.Address <> firstAddress
    End If
End With
 
 
'Alimentation de la feuille
With Sheets(occurs)
         .Range("A2", .Range("A2").Offset(UBound(Tablo, 2) - 1, UBound(Tablo, 1) - 1)).Value = WorksheetFunction.Transpose(Tablo)
End With
 
'Réinitialisation de la variable Tablo
Erase Tablo
 
End Sub

La fonction de transformation de(s) la(les) lettre(s) colonne en nombre.
(pour ma part, dans module séparé)

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
Public Colonne()
Public Alphabet()
 
Function Colnuméric(col)
'Stockage de l'alphabet
Alphabet = Array("", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
col = UCase(col) 'Pour eviter les erreurs de case
For i = 1 To 26
        'Correspondance lettre <=> chiffre (rang)
        ReDim Preserve Colonne(2, i + 1)
        Colonne(1, i) = Alphabet(i)
        Colonne(2, i) = i
Next i
 
Select Case Len(col)
    Case 1 'Cas ou la colonne rentrée est entre A et Z
            For i = 1 To 26
                    If Colonne(1, i) = col Then
                            indice = Colonne(2, i)
                            Exit For
                    End If
            Next 'Cas ou la colonne rentrée comporte 2 lettres
    Case 2
            For i = 1 To 26
                    If Colonne(1, i) = Left(col, 1) Then
                            indice1 = Colonne(2, i)
                            Exit For
                    End If
            Next i
            For i = 1 To 26
                    If Colonne(1, i) = Right(col, 1) Then
                            indice2 = Colonne(2, i)
                            Exit For
                    End If
            Next i
            indice = (indice1 * 26) + indice2
End Select
 
Colnuméric = indice
 
End Function

Variante dictionnaire (trié)

'

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
----------------------------------------------------------------------------------------------------------------------------CREATION LISTE PAR METHODE DICTIONNAIRE----------------------------------------------------------------------------------------------------------------------------
Sub Creer_Liste_Feuilles(Plage As Range)
 
'PRECAUTION PREALABLE : ACTIVER LA REFERENCE "MICROSOFT SCRIPTING RUNTIME"
 
Dim Dico
Dim c As Range
Dim temp
Dim d
Dim d1
Dim d2 As String
 
Set Dico = CreateObject("Scripting.Dictionary")
For Each c In Plage
    If Not Dico.Exists(c.Value) Then Dico.Add c.Value, c.Value
Next c
 
 temp = Dico.items
Call Tri(temp, LBound(temp), UBound(temp)) ' voir module mod_tri
 
For d = LBound(temp) To UBound(temp)
        'l'argument de la procédure Gestion_Feuilles est de type string
        d1 = temp(d)
        d2 = IIf(IsNumeric(d1), CStr(d1), d1)
        Call Gestion_Feuilles(d2)
Next d
 
Set Dico = Nothing
 
End Sub
'---------------------------------------------------------------------------------------------------------------------------- TRI DE DICTIONNAIRE----------------------------------------------------------------------------------------------------------------------------
 
Sub Tri(a As Variant, gauc As Long, droi As Long)   ' Quick sort
 
Dim g As Long, d As Long
Dim ref As Variant
Dim t As Variant
 
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
 
Do
        Do While a(g) < ref
                g = g + 1
        Loop
        Do While ref < a(d)
                d = d - 1
        Loop
        If g <= d Then
                t = a(g)
                a(g) = a(d)
                a(d) = t
                g = g + 1
                d = d - 1
        End If
Loop While g <= d
 
If g < droi Then Call Tri(a, g, droi)
 
If gauc < d Then Call Tri(a, gauc, d)
 
End Sub

[Ormonth]

Bonjour,

(1) Il me pardonnera, je l’espère, j’ai passé outre la remarque – judicieuse par ailleurs – de Didier dans son intéressant tutoriel sur les saisies numériques obligatoires. J’ai donc utilisé la propriété « Isnuméric »

le but du Tuto est dans le début de son titre "Approche d'une résolution de besoin en VBA....". si l'analyse des besoins montre que le risque de l'emploi de isNuméric est négligeable, il est sot de faire une usine à gaz pour rien, tu as donc tout à fait raison.

IsNumeric ne bogue pas, c'est son emploi abusif qu'on en fait qui est trompeur le définition de la fonction est :

Renvoie une valeur de type Boolean qui indique si une expression peut être interprétée comme un nombre.

Elle n'est absolument pas :" indique si l'expression n'est constituée que de chiffres". Ne pas mélanger les chiffres et les nombres, les nombres en Hexa utilisent naturellement 6 lettres de l'alphabet...

Sinon pas eu le temps de regarder en détail, mais l'énoncé de base me fait penser furieusement à un TCD qui sait créer x feuilles à la volée si demandé...

cordialement,

Didier

[MarcelG]

Bonjour au Forum,

Merci, Didier, pour ta réponse. Je n'utilise pas ici de tableau croisé mais des variables tableaux depuis une collection ou un dictionnaire.

Sur ce dernier point, je viens de lire à nouveau sur le Web que le dictionnaire est préférable à la collection, jugée trop lente.

Quel est votre avis? Quelqu'un a-t-il établi une mesure comparative?

Bon week-end à tous.

[Ormonth]

Bonjour,

j'ai bien compris que tu n'utilisais pas de TCD , mais justement c' est peut être une piste à explorer, même si je suis très très VBA, j'en utilise souvent pour des rapports d'extractions de données d'Appli encapsulées car c'est bien plus rapide que ce que je pourrais faire en code, sans compter que c'est bien plus simple à mettre en œuvre => Appli plus légère.

pour la rapidité, tu fais tes tests avec un timer (comme ici http://www.developpez.net/forums/d11...sion-dates/#17) et tu regardes, mais bon sauf si grosse masses de données c'est ce sur quoi on est plus à l'aise qui a la priorité

cordialement,

Didier

[MarcelG]

Bonjour le Forum,

J'ai effectué la comparaison collection - dictionnaire pour ce développement.

Pour 276 lignes et 18 occurences, les temps de traitement ont été les suivants :

- méthode collection : 1,60 seconde

- méthode dictionnaire : 1,16 seconde

Le temps de traitement par la méthode dictionnaire est plus rapide. Le temps de traitement est inférieur d'environ 30 % par rapport à la méthode collection.

C'est ici mon constat pour ce cas précis.

Bonne journée à tous.

[sylvestre09]

Bonjour Marcel,
Ce que tu nous a présenté est vraiment très interessant mais je trouve que pour un debutant comme moi c'est difficile de comprendre la logique des choses afin d'adapter .. je suppose que c'est le but de ton tutoriel ! donc est-il possible de nous joindre un exemple simple ??! Merci d'avance peu importe la reponse

[MarcelG]

Bonjour sylvestre09, Bonjour le Forum,

(désolé pour cette absence momentanée)

sylvestre,

Ci-joint un claseur exemple que tu pourras étudier.

Pour créer les feuilles souhaitées, il te faut activer le bouton jaune sur la feuille de synthèse.

Bon week-end à tous.

[sylvestre09]

Bonjour Marcel , en fait si on connais la colonne de nos occurences on peux s'en passer de l'inputbox donc je pense que si cette dérnière est la colonne "D" donc on peux enlever

Code :

1
2
choix_col = InputBox("Entrer la colonne où se trouvent les occurences des feuilles à créer" & Chr(10) & "En lettres ou en chiffres", "Colonnes choisie")
    numcol = IIf(IsNumeric(choix_col), choix_col, Colnuméric(choix_col))

et ensuite remplacer dans

Code :

1
2
3
4
With Sheets("Synth")
            Set dercel = .Cells(.Rows.Count, numcol).End(xlUp)
            Set liste = .Range(.Cells(2, numcol), dercel)
    End With

numcol par "4" (colonneD) et je garde le reste par contre je ne vois pas à quoi ca sert la fonction_colonne !! peux-tu m'eclairer stp !!

Et enfin si jamais on rajoute une ligne il faux cliquer encore une fois sur le bouton pour actualier les pages (ce qui n'est pas pratique pour moi car chaque jours j'ai plusieur opération a entrer) donc est_il possible qu'il actualise automatiquement les feuilles ??
Merci d'avance

[sylvestre09]

Re en fait j'ai un petit soucis avec la dimension du tableau voilà quand il me creer les feuilles il ne prend pas les premieres colonne en considération et puis la ligne des intitulés aussi bref je suppose que c'est la UBound qui pose probleme et j'arrive pas a le resoudre help please !!