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 |
Aide simplification programmes VBA
Répondre avec citation
et 
si la réponse vous a été utile !
Partager