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
| ' Macro1 Macro
' Macro enregistrée le 28/01/2011 par yxk478'
'arret des messages du presse-papier
Application.DisplayAlerts = False
'copie du fichier
Windows("default").Activate
Range("A1:F300").Copy
Windows("classeur1.xls").Activate
Sheets("Data").Select
Range("A1").Select
ActiveSheet.Paste
'Fermeture du classeur
Windows("default.xls").Activate
ActiveWindow.Close SaveChanges:=True
'Création colonne Duree activite Abs avec calcul
Range("F2").FormulaR1C1 = "=RC[-1]*24"
Range("F2").AutoFill Destination:=Range("F2:F300"), Type:=xlFillDefault
Range("F2:F300").NumberFormat = "0.00"
'Parametres format celulles
Range("I8:I15").NumberFormat = "0.00"
'Calcul trajet
Range("I14").FormulaR1C1 = "=SUM(R[-6]C[-5]:R[300]C[-5])"
'Calcul Ticket CAC
Range("J20").Value = "=SUMPRODUCT((B2:B300>2000)*1)"
Range("J21").Value = "=SUMPRODUCT((B2:B300=""NULL"")*1)"
Range("I15").Value = Range("J20").Value - Range("J21").Value
'Calcul INDUS PREVE
Range("A1:F1").AutoFilter
ActiveSheet.Range("$A$1:$F$300").AutoFilter Field:=1, Criteria1:= _
"PREVENTIF"
ActiveSheet.Range("$A$1:$F$300").AutoFilter Field:=3, Criteria1:="=*ttf*" _
, Operator:=xlAnd
Columns("A:F").Copy
Sheets("Data2").Select
Range("A1").Select
ActiveSheet.Paste
Range("H11").Select
ActiveCell.FormulaR1C1 = "=SUM(C[-2])"
Range("H11").Copy
Sheets("Data").Select
Range("I11").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Range("$A$1:$F$300").AutoFilter Field:=1
ActiveSheet.Range("$A$1:$F$300").AutoFilter Field:=3
Sheets("Data2").Select
Cells.ClearContents
Sheets("Data").Select
'Calcul INDUS CUR
ActiveSheet.Range("$A$1:$F$300").AutoFilter Field:=1, Criteria1:= _
"CORR-SITE"
ActiveSheet.Range("$A$1:$F$300").AutoFilter Field:=3, Criteria1:="=*ttf*" _
, Operator:=xlAnd
Columns("A:F").Copy
Sheets("Data2").Select
Range("A1").Select
ActiveSheet.Paste
Range("H20").FormulaR1C1 = "=SUM(C[-2])"
Range("H20").Copy
Sheets("Data").Select
Range("I12").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Range("$A$1:$F$300").AutoFilter Field:=1
ActiveSheet.Range("$A$1:$F$300").AutoFilter Field:=3
Sheets("Data2").Select
Cells.ClearContents
Sheets("Data").Select
Range("I13").Value = Range("I12") + Range("I11")
'Calcul corr-distance assitance
ActiveSheet.Range("$A$1:$F$300").AutoFilter Field:=1, Criteria1:= _
"=CORR-ASSIST", Operator:=xlOr, Criteria2:="=CORR-DISTANCE"
Columns("A:F").Copy
Sheets("Data2").Select
Range("A1").Select
ActiveSheet.Paste
Range("H8").FormulaR1C1 = "=SUM(C[-2])"
Range("H8").Copy
Sheets("Data").Select
Range("I8").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Range("$A$1:$F$300").AutoFilter Field:=1
Sheets("Data2").Select
Cells.ClearContents
Sheets("Data").Select
'Calcul Corr-site hors corr-distance corr-assist hors ttf
ActiveSheet.Range("$A$1:$F$300").AutoFilter Field:=1, Criteria1:=Array( _
"CORR-INJUST", "CORR-SITE", "DEP-INST-DESINST", "DEP-MISE-A-NIVEAU", "ETUDES-TECH", _
"PREP-ATELIER", "PREVENTIF", "="), Operator:=xlFilterValues
ActiveSheet.Range("$A$1:$F$300").AutoFilter Field:=3, Criteria1:="<>*ttf*" _
, Operator:=xlAnd
Columns("A:F").Copy
Sheets("Data2").Select
Range("A1").Select
ActiveSheet.Paste
Range("H10").FormulaR1C1 = "=SUM(C[-2])"
Range("H10").Copy
Sheets("Data").Select
Range("I9").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Range("$A$1:$F$300").AutoFilter Field:=1
ActiveSheet.Range("$A$1:$F$300").AutoFilter Field:=3
Sheets("Data2").Select
Cells.ClearContents
Sheets("Data").Select
Range("I10").Value = Range("I8") + Range("I9")
'demande du mois à traiter
Dim Reponse As String
Reponse = InputBox("Quel est le mois à traiter?")
Range("N1").Value = Reponse
Range("I8:I15").Copy
Range("L5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Selection.NumberFormat = "0.00"
'Copie dans feuille 1
Dim CelCible As Range
Dim Mois As String
Mois = Right(Worksheets("Data").Range("N1"), 9)
Set CelCible = Worksheets("Feuil1").Range("a:a").Find(what:=Mois, LookIn:=xlValues, lookat:=xlWhole)
If Not CelCible Is Nothing Then
Worksheets("Data").Range("L5:S5").Copy CelCible(1, 2)
End If
'Reparametrage tableau
Sheets("Feuil1").Select
Range("B2:I14").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
'Suppression des données dans data
Sheets("Data2").Select
Cells.ClearContents
Range("A1").Select
Sheets("Data").Select
Cells.ClearContents
Range("A1").Select
Sheets("Feuil1").Select
Range("A1").Select
'Affichage message apres traitement
MsgBox "Traitement Terminé", vbOKOnly + vbInformation, "Traitement Données"
End Sub |
Simplification d'une macro
Répondre avec citation
Partager