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
|
'On créé un type machine ce qui est plus pratique que de passer par des variables multiples
'(la flemme de passer par des modules de classes...)
Public Type typeMachine
Cches As Integer
Spi As Double
Dist As Double
End Type
'Cette fonction va affecter les bons nombres avec les bons éléments, en supoposant que Cches,Spi et Dist se suivent dans cet ordre
'(du coup un module de classe aurait été plus "propre"...)
Public Sub affecterElementMachine(ByRef machine As typeMachine, ByVal feuille As Worksheet, ByVal nbElementsParMachine As Byte, ByVal ligne As Integer, ByVal colonne As Integer)
Select Case nbElementsParMachine
Case 0
machine.Cches = Worksheets("FeuilMachine").Cells(ligne, colonne)
Case 1
machine.Spi = Worksheets("FeuilMachine").Cells(ligne, colonne)
Case 2
machine.Dist = Worksheets("FeuilMachine").Cells(ligne, colonne)
End Select
End Sub
'Pour une variable de type typeMachine on va renseigner les différents champs
Public Sub renseignerMachine(ByRef machine As typeMachine, ByVal feuille As Worksheet, ByVal colonne As Integer)
Dim nbElementsParMachine As Byte, i As Integer
nbElementsParMachine = 0
i = 2
'Dès que l'on a récupéré les valeurs cches,Spi, et Dist on arrête de parcourir les lignes de la colonne
While nbElementsParMachine < 3
'En parcourant chaque ligne de la colonne concernée, si on trouve une valeur, alors on l'a récupère
If (feuille.Cells(i, colonne) <> "") Then
affecterElementMachine machine, feuille, nbElementsParMachine, i, colonne
nbElementsParMachine = nbElementsParMachine + 1
End If
i = i + 1
Wend
End Sub
Public Sub remplirFeuilleResultats(ByRef feuilleResultat As Worksheet, ByRef machine As typeMachine, ByRef position As Integer, ByVal numeroMachine As Byte, ByRef tableDimension() As Double)
Dim i As Integer, dimensionDebut As Double, dimensionFin As Double, dimensionInterm As Double
dimensionDebut = tableDimension(numeroMachine - 1)
dimensionFin = tableDimension(numeroMachine)
'Dans l'exemple pour la machine 1, tous les diamètres sont différentiés par une valeur de 41
'soit (512-225)/(8-1)
dimensionInterm = Abs(dimensionFin - dimensionDebut) / (machine.Cches - 1)
'Les premiers libellés pour la machine concernée
feuilleResultat.Range("A" & position) = "Machine " & numeroMachine
With feuilleResultat.Range("A" & position & ":G" & position)
.Merge
.HorizontalAlignment = xlCenter
End With
feuilleResultat.Range("A" & position + 1) = "Cches:"
feuilleResultat.Range("C" & position + 1) = "Spi:"
position = position + 2
For i = 1 To machine.Cches
feuilleResultat.Range("B" & position) = i
feuilleResultat.Range("D" & position) = machine.Spi * i / machine.Cches
feuilleResultat.Range("E" & position + 1) = "Dist:"
feuilleResultat.Range("F" & position + 1) = machine.Dist
feuilleResultat.Range("G" & position) = "Diam:"
feuilleResultat.Range("H" & position) = dimensionDebut + (dimensionInterm * (i - 1))
position = position + 2
Next
End Sub
Private Function colonneDimensions(ByVal feuille As Worksheet, ByVal champ As String) As Integer
Dim j As Integer
j = 1
'Attention champ doit être correctement écrit sinon la boucle parcours chaque colonne et le programme va planter
While (feuille.Cells(1, j) <> champ)
j = j + 1
Wend
colonneDimensions = j + 2
End Function
Public Sub recupererDimensions(ByRef tableDimension() As Double, ByVal feuille As Worksheet, ByVal colonne As Integer)
Dim i As Integer, taille As Integer
i = 1: taille = -1
While feuille.Cells(i, colonne) <> ""
If (feuille.Cells(i, colonne) <> 0) Then
'On considère que la dimension est différente de zéro (selon l'exemple)
taille = taille + 1
ReDim Preserve tableDimension(taille)
tableDimension(taille) = feuille.Cells(i, colonne)
End If
i = i + 1
Wend
End Sub
Public Sub remplirTableMachines(ByRef feuilleOrigine As Worksheet, ByRef tableMachines() As typeMachine)
Dim nbMachine As Integer, j As Integer
nbMachine = -1: j = 1
'On considère que le la première machine est dans la colonne 1 et que tant qu'il y a quelque chose chaque première case de
'chaque colonne, on a une machine
While (feuilleOrigine.Cells(1, j) <> "")
nbMachine = nbMachine + 1
ReDim Preserve tableMachines(nbMachine)
renseignerMachine tableMachines(nbMachine), feuilleOrigine, j
j = j + 1
Wend
End Sub
'Procédure principale à exécuter
Public Sub finalisation()
Dim tableDimension() As Double, tableMachines() As typeMachine, feuilleOrigine As Worksheet, feuilleResultats As Worksheet
Dim j As Integer, position As Integer
' La feuille d'origine avec les données s'appelle FeuilMachine
Set feuilleOrigine = Worksheets("FeuilMachine")
'La feuille avec les résultats voulus s'appelle FeuilRapat
Set feuilleResultats = Worksheets("FeuilRapat")
'On supprime toutes les données de la feuille de résultats
feuilleResultats.Cells.Delete
position = 1
'On suppose que les dimensions se trouvent deux colonnes après la colonne avec "int."
recupererDimensions tableDimension, feuilleOrigine, colonneDimensions(feuilleOrigine, "int.")
'On récupère les données de chaque machine dans la table des machines....
remplirTableMachines feuilleOrigine, tableMachines
'Pour chaque machine, on met les données en forme dans la feuille des résultats
For j = 0 To UBound(tableMachines)
remplirFeuilleResultats feuilleResultats, tableMachines(j), position, j + 1, tableDimension
Next
Set feuilleOrigine = Nothing
Set feuilleResultats = Nothing
End Sub |
Générer une feuille excel regroupant des données d'autres feuilles ou classeurs
:
Répondre avec citation
Partager