Discussion :

[010714]

Bonjour,
Je m'appelle Marie, j'ai 21 ans et j'aurais besoin de votre aide pour simplifier mon programme VBA.
Il fonctionne mais est long et bug souvent...
Je n’ai pas de compétences particulières en informatique c’est pourquoi je me tourne vers vous.
J'ai réussi à faire mon programme en m'inspirant sur différents forums et en adaptant au cas par cas des morceaux de programmes.

Je vous explique le fonctionnement de mon fichier Excel à travers mes 5 feuilles différentes :

Machine1 ; Machine2 ; Machine3 :
Sur ces feuilles ce trouvent les données des 3 machines (Machine 1, Machine2, Machine 3).
Pour chacune de ces machines il y a un tableau « statistique » et un tableau « récapitulatif ».
Le tableau statistique est composé de 4 colonnes : « Nom de la zone ; Objectif ; Réalisé ; Temps total ». La colonne « Réalisé » contient une mise en forme de la couleur des cellules en fonction de l’objectif : (vert>=80%) (>50% Orange <80%) & (<50% Rouge).
La colonne « réalisé » recherche en fonction du nom de la zone le nombre de fois que ce nom revient dans la colonne A de la feuille 3.
La colonne « Temps total » quant à elle fait la somme des temps de la feuille 3 du nom de la zone en question.
Le tableau « Récapitulatif » contient 6 colonnes « Exception Nom machine ; Nom du point ; Date heure ; Etat d’alarme ; Résultat contrôle ; Commentaire ».

Feuile2 :
Je colle dans la cellule A1 de cette feuille les données que vous pouvez trouver sur la feuille : « Exemple données Feuil2 » (souvent plus de 1000 lignes).
Le programme plante si il y a un « = » qui s’est glissé avant, je suis donc obligé de faire un recherche du caractère égal dans cette feuille et de le supprimer.
Sur cette feuille, une fois le programme exécuté, les informations sont rangées en 5 colonnes différentes.
Je sélectionne ensuite les données pour les coller manuellement à leur emplacement (tableau « récapitulatif ») en fonction de la machine sur la feuil1, je dois mettre manuellement la mise en forme.
J’aimerais pouvoir automatiser cette tâche en collant les données automatiquement sur la page de la machine spécifiée (Feuil1) avec une mise en forme automatique (bordure du tableau).

Feuile3 :
Je colle dans la cellule A1 de cette feuille les données que vous pouvez trouver sur la feuille : « Exemple données Feuil3 »
En exécutant le programme XX les données dont mise sous une forme spéciale « Nom de la zone ; Date ; Durée ; %réalisé »
Dans la Feuile1 au niveau du tableau statistique j’ai écrit une formule qui va rechercher pour chacun des noms de zone le nombre réalisé et le temps total passé.

J’aimerais que les mesures inférieure ou égale à 60% réalisé soit supprimés et également remplacer les temps de chaque zone supérieure à 45 minutes par 15 minutes.
J’aimerais aussi que le tableau « statistique » des feuilles des 3 machines ce remplisse automatiquement à partir du programme VBA.

Je vous joins mon fichier en .xlsx avec mon programme à la suite du message, j’ai essayé de détailler au maximum les opérations.
Dans l’attente de votre aide

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
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
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
Sub Rapport_Mensuel()
virgule = Array(",")
Point = Array(".")
With Cells.SpecialCells(xlCellTypeConstants)
.Replace virgule, Point 'remplace les caracteres "," par "."
End With
 
'Efface "Hiérarchie"
origcaractere = Array("Hiérarchie / ")
newcaractere = Array("")
With Cells.SpecialCells(xlCellTypeConstants)
.Replace origcaractere, newcaractere
End With
 
n = [A1000].End(xlUp).Row
a = [A4].Resize(n).Value 'A1 si on veut garder l'entête
    Dim j As Integer
    Dim b As Variant, i As Long
For k = 1 To n
    b = Split(a(k, 1), "    ") 'séparer les mots espacés de 4 espaces
         For i = 0 To UBound(b) 'chaque mots de la phrase
            For j = i + 2 To UBound(b) + 2
    Cells(k, j).Value = b(i) 'ranger dans la cellule de droite le mot
            Next j
        Next i
Next k
Columns("A:A").Delete Shift:=xlToLeft 'supprimer la 1ère colonne de données collés
Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete 'efface toutes les lignes vides
Columns("A:K").HorizontalAlignment = xlCenter 'centrer le texte
Columns("D:E").NumberFormat = "General"
 
Dim z As Range
For Each z In Range("A:C", [A1000].End(xlUp))
   If z.Value = "---" Then z.Value = z.Offset(-1, 0).Value 'Si la cellule contient "---", elle prend la valeur de celle du dessus
Next z
 
 c = ActiveSheet.UsedRange.Rows.Count
    For d = c To 1 Step -1
        If Cells(d, 6) Like "---" And Cells(d, 8) Like "---" Then Rows(d).Delete 'efface les lignes si il y a "---" dans les colonnes F et H
        If Cells(d, 8) Like "OK" Then Rows(d).Delete 'efface les lignes si il y a "OK" dans les colonnes F et H
        If Cells(d, 8) Like "Ensemble OK" Then Rows(d).Delete 'efface les lignes si il y a "Ensemble OK" dans les colonnes F et H
        If Cells(d, 1) Like " " Then Rows(d).Delete 'efface les lignes contenant " " bug?
        If Cells(d, 3) Like "Machine à l'arrêt" Then Rows(d).Delete 'efface les lignes ou la colonne 3 contient "Machine à l'arrêt"
'rajouter les differents cas qui ne sont pas en alerte
   Next d
 
Dim y As Range
For Each y In Range("F1", [F1000].End(xlUp))
   If y.Value = "---" Then y.Value = y.Offset(-1, 0).Value 'Si la cellule dans la colonne F contient "---", elle prend la valeur de celle du dessus
Next y
 
'Met sous la forme dd/mm/yyyy la date
Dim ic As Long
Dim vc As Double
Dim jc As Integer, mc As Integer, ac As Integer
Dim sJc As String, sMc As String
Dim sc As String
 
    For ic = 1 To 1000
        If IsDate(Cells(ic, 3)) Then
            vc = CDbl(CDate(Cells(ic, 3)))
            jc = Day(vc)
            mc = Month(vc)
            ac = Year(vc)
 
            Select Case jc
                Case 1 To 9: sJc = "0" & jc
                Case Else: sJc = jc
            End Select
 
            Select Case mc
                Case 1 To 9: sMc = "0" & mc
                Case Else: sMc = mc
            End Select
 
            sc = sJc & "/" & sMc & "/" & ac
 
            Cells(ic, 3).NumberFormat = "General"
            Cells(ic, 3) = Format(sc, "dd/mm/yyyy")
        End If
    Next ic
 
'Pour les dates des notes, modifier "2" par le numéro de colonnes ou elle sera apres découpage
Dim ib As Long
Dim vb As Double
Dim jb As Integer, mb As Integer, ab As Integer
Dim sJb As String, sMb As String
Dim sb As String
 
    For ib = 1 To 1000
        If IsDate(Cells(ib, 2)) Then
            vb = CDbl(CDate(Cells(ib, 2)))
            jb = Day(vb)
            mb = Month(vb)
            ab = Year(vb)
 
            Select Case jb
                Case 1 To 9: sJb = "0" & jb
                Case Else: sJb = jb
            End Select
 
            Select Case mb
                Case 1 To 9: sMb = "0" & mb
                Case Else: sMb = mb
            End Select
 
            sb = sJb & "/" & sMb & "/" & ab
 
            Cells(ib, 2).NumberFormat = "General"
            Cells(ib, 2) = Format(sb, "dd/mm/yyyy")
        End If
    Next ib
 
'Ajoute une ligne devant "Notes Nom source"
cc = ActiveSheet.UsedRange.Rows.Count
    For dc = cc To 1 Step -1
        If Cells(dc, 1) Like "Notes Nom source" Then Rows(dc).EntireRow.Insert Shift:=xlDown 'Insere une ligne avant "Notes Nom Source"
Next dc
 
Columns(7).Delete Shift:=xlToLeft 'Supprime la colonne G "Message d'alarme
Columns(4).Delete Shift:=xlToLeft 'Supprime la colonne D "Message d'alarme
Columns(4).Delete Shift:=xlToLeft 'Supprime la colonne E "Message d'alarme
 
origString = Array(" / ")
newString = Array("    ")
With Cells.SpecialCells(xlCellTypeConstants)
.Replace origString, newString 'remplace les caracteres " / " par "    "
End With
 
'inserer 2 colonnes vierges
Columns(2).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns(2).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
 
ni = [A100].End(xlUp).Row
ai = [A1].Resize(ni).Value
    Dim ji As Integer
    Dim bi As Variant, ii As Long
For ki = 1 To ni
    bi = Split(ai(ki, 1), "    ") 'séparer les mots espacés de 4 espaces
         For ii = 0 To UBound(bi) 'chaque mots de la phrase
            For ji = ii + 2 To UBound(bi) + 2
    Cells(ki, ji).Value = bi(ii) 'ranger dans la cellule de droite le mot
            Next ji
        Next ii
Next ki
 
Columns("A:A").Delete Shift:=xlToLeft 'supprimer la 1ère colonne de données collés
Columns(2).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlToLeft 'efface les cellules vides de la colonne 2 en faisant un décallage vers la gauche
 
cf = ActiveSheet.UsedRange.Rows.Count
    For df = cf To 1 Step -1
        If Cells(df, 1) Like "Notes Nom source" Then Rows(df).EntireRow.Delete 'Supprime la ligne "Notes Nom Source"
Next df
 
 
Columns("A:K").Columns.AutoFit 'ajuster la largeur des colonnes
 
End Sub
 
Sub Suivi_Rondes()
virgule = Array(",")
Point = Array(".")
With Cells.SpecialCells(xlCellTypeConstants)
.Replace virgule, Point 'remplace les caracteres "," par "."
End With
 
n = [A1000].End(xlUp).Row
a = [A5].Resize(n).Value 'A1 si on veut garder l'entête
    Dim j As Integer
    Dim b As Variant, i As Long
For k = 1 To n
    b = Split(a(k, 1), "    ") 'séparer les mots espacés de 4 espaces
         For i = 0 To UBound(b) 'chaque mots de la phrase
            For j = i + 2 To UBound(b) + 2
    Cells(k, j).Value = b(i) 'ranger dans la cellule de droite le mot
            Next j
        Next i
Next k
 
Columns("A:A").Delete Shift:=xlToLeft 'supprimer la 1ère colonne de données collés
Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete 'efface toutes les lignes vides
Columns("A:K").HorizontalAlignment = xlCenter 'centrer le texte
 
'Met sous la forme dd/mm/yyyy la date
Dim ii As Long
Dim v As Double
Dim jj As Integer, m As Integer, aa As Integer
Dim sJ As String, sM As String
Dim s As String
 
    For ii = 1 To 1000
        If IsDate(Cells(ii, 2)) Then
            v = CDbl(CDate(Cells(ii, 2)))
            jj = Day(v)
            m = Month(v)
            aa = Year(v)
 
            Select Case j
                Case 1 To 9: sJ = "0" & jj
                Case Else: sJ = jj
            End Select
 
            Select Case m
                Case 1 To 9: sM = "0" & m
                Case Else: sM = m
            End Select
 
            s = sJ & "/" & sM & "/" & aa
 
            Cells(ii, 2).NumberFormat = "General"
            Cells(ii, 2) = Format(s, "dd/mm/yyyy")
        End If
    Next ii
 
Columns(4).NumberFormat = "General"
Columns("A:K").Columns.AutoFit 'ajuster la largeur des colonnes
Dim z As Range
For Each z In Range("A:C", [A1000].End(xlUp))
   If z.Value = "---" Then z.Value = z.Offset(-1, 0).Value 'Si la cellule contient "---", elle prend la valeur de celle du dessus
Next z
 
c = Array("h")
cc = Array("")
'With Cells.SpecialCells(xlCellTypeConstants)
With Columns(3)
.Replace c, cc
'End With
d = Array("m")
dd = Array("")
'With Cells.SpecialCells(xlCellTypeConstants)
.Replace d, dd
'End With
e = Array("s")
ee = Array("")
'With Cells.SpecialCells(xlCellTypeConstants)
.Replace e, ee
'End With
f = Array(": ")
ff = Array(":")
'With Cells.SpecialCells(xlCellTypeConstants)
.Replace f, ff
End With
 
Columns(3).NumberFormat = "[h]:mm:ss;@"
 
End Sub