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
| Sub Traitements()
Dim i As Integer, j As Byte, f As Worksheet, x As Integer, w As Integer
Set f = Sheets("HISTO")
Application.ScreenUpdating = False
'efface les valeurs des feuilles
Sheets("Gard1").Range("A2:K5000").Clear
Sheets("Gard2").Range("A2:K5000").Clear
Sheets("Gard3").Range("A2:K5000").Clear
Sheets("Gard4").Range("A2:K5000").Clear
Sheets("histo").Select
With Sheets("HISTO")
For i = 2 To f.Range("A" & Rows.Count).End(xlUp).Row
Set f = Sheets("HISTO")
'copie les valeurs selon conditions "MEDecin",INTerne sur la feuille Garde1
If f.Range("A" & i) = "MED" Or Range("A" & i) = "INT1" Or Range("A" & i) = "INT2" Or Range("A" & i) = "INT3" Then
f.Range("A" & i & ":i" & i).Copy Sheets("Gard1").Range("A" & Sheets("Gard1").Range("A" & Rows.Count).End(xlUp).Row + 1)
Else
'copie les valeurs selon conditions "INFirmier" sur la feuille Garde2
If f.Range("A" & i) = "INF1" Or Range("A" & i) = "INF2" Then
f.Range("A" & i & ":i" & i).Copy Sheets("Gard2").Range("A" & Sheets("Gard2").Range("A" & Rows.Count).End(xlUp).Row + 1)
Else
'copie les valeurs selon conditions "AideSoignant", sur la feuille Garde3 et Garde4
If f.Range("A" & i) = "AS1" Or Range("A" & i) = "AS2" Then
f.Range("A" & i & ":i" & i).Copy Sheets("Gard3").Range("A" & Sheets("Gard3").Range("A" & Rows.Count).End(xlUp).Row + 1)
f.Range("A" & i & ":i" & i).Copy Sheets("Gard4").Range("A" & Sheets("Gard4").Range("A" & Rows.Count).End(xlUp).Row + 1)
Else
'copie les valeurs selon conditions "AgentHosp" sur la feuille Garde4
If f.Range("A" & i) = "ASH1" Or Range("A" & i) = "ASH2" Then
f.Range("A" & i & ":i" & i).Copy Sheets("Gard4").Range("A" & Sheets("Gard4").Range("A" & Rows.Count).End(xlUp).Row + 1)
End If
End If
End If
End If
Next i
End With
SupDateINF
End Sub
Sub SupDateINF()
Sheets("Gard1").Select
'supprime la ligne selon la date plus ancienne d'une personne de la colonne E en fonction du nom_prenom colonne I
Dim i As Long, j As Long, dercell As Long, valcell As String
With Sheets("Gard1")
For i = Cells(Rows.Count, 9).End(xlUp).Row To 2 Step -1
For j = Cells(Rows.Count, 9).End(xlUp).Row To 2 Step -1
If Cells(j, 9) = Cells(i, 9) Then 'compare le nom
If Cells(j, 5) < Cells(i, 5) Then 'compare la date
Cells(j, 1).EntireRow.Delete
End If: End If
Next j: Next i
Sheets("Gard1").Select
'écrit les formules dans les colonne J et K
dercell = Range("a65000").End(xlUp).Row
valcell = Range("a65000").End(xlUp).Address
Range("J2" & ":" & "J" & dercell).FormulaR1C1 = "=RANK.EQ(RC[1],C[1])" 'formule RANG dans la colonne J
Range("K2" & ":" & "K" & dercell) = "=IF(RC[-6]="""",TODAY()-RC[-4],TODAY()-RC[-6])" 'formule écart aujourdhui - date colonne E ou G si E est vide
[J:J].Value = [J:J].Value 'copie valeur uniquement
[K:K].Value = [K:K].Value 'copie valeur uniquement
Range("J2:J5000").NumberFormat = "0" 'format numérique colonne J
Range("G2" & ":" & "G" & dercell).NumberFormat = "m/d/yyyy"
Columns("A:K").Sort key1:=Range("J2"), Header:=xlYes 'tri ascendant colonne J
End With
With Sheets("Gard2")
'idem Gard1
For i = Cells(Rows.Count, 9).End(xlUp).Row To 2 Step -1
For j = Cells(Rows.Count, 9).End(xlUp).Row To 2 Step -1
If Cells(j, 9) = Cells(i, 9) Then 'compare le nom
If Cells(j, 5) < Cells(i, 5) Then 'compare la date
Cells(j, 1).EntireRow.Delete
End If: End If
Next j: Next i
Sheets("Gard2").Select
dercell = Range("a65000").End(xlUp).Row
valcell = Range("a65000").End(xlUp).Address
Range("J2" & ":" & "J" & dercell).FormulaR1C1 = "=RANK.EQ(RC[1],C[1])"
Range("K2" & ":" & "K" & dercell) = "=IF(RC[-6]="""",TODAY()-RC[-4],TODAY()-RC[-6])"
[J:J].Value = [J:J].Value
[K:K].Value = [K:K].Value
Range("J2:J5000").NumberFormat = "0"
Range("G2" & ":" & "G" & dercell).NumberFormat = "m/d/yyyy"
Columns("A:K").Sort key1:=Range("J2"), Header:=xlYes
End With
With Sheets("Gard3")
'idem Gard1
For i = Cells(Rows.Count, 9).End(xlUp).Row To 2 Step -1
For j = Cells(Rows.Count, 9).End(xlUp).Row To 2 Step -1
If Cells(j, 9) = Cells(i, 9) Then 'compare le nom
If Cells(j, 5) < Cells(i, 5) Then 'compare la date
Cells(j, 1).EntireRow.Delete
End If: End If
Next j: Next i
Sheets("Gard3").Select
dercell = Range("a65000").End(xlUp).Row
valcell = Range("a65000").End(xlUp).Address
Range("J2" & ":" & "J" & dercell).FormulaR1C1 = "=RANK.EQ(RC[1],C[1])"
Range("K2" & ":" & "K" & dercell) = "=IF(RC[-6]="""",TODAY()-RC[-4],TODAY()-RC[-6])"
[J:J].Value = [J:J].Value
[K:K].Value = [K:K].Value
Range("J2:J5000").NumberFormat = "0"
Range("G2" & ":" & "G" & dercell).NumberFormat = "m/d/yyyy"
Columns("A:K").Sort key1:=Range("J2"), Header:=xlYes
End With
With Sheets("Gard4")
'idem Gard1
For i = Cells(Rows.Count, 9).End(xlUp).Row To 2 Step -1
For j = Cells(Rows.Count, 9).End(xlUp).Row To 2 Step -1
If Cells(j, 9) = Cells(i, 9) Then 'compare le nom
If Cells(j, 5) < Cells(i, 5) Then 'compare la date
Cells(j, 1).EntireRow.Delete
End If: End If
Next j: Next i
Sheets("Gard4").Select
dercell = Range("a65000").End(xlUp).Row
valcell = Range("a65000").End(xlUp).Address
Range("J2" & ":" & "J" & dercell).FormulaR1C1 = "=RANK.EQ(RC[1],C[1])"
Range("K2" & ":" & "K" & dercell) = "=IF(RC[-6]="""",TODAY()-RC[-4],TODAY()-RC[-6])"
[J:J].Value = [J:J].Value
[K:K].Value = [K:K].Value
Range("J2:J5000").NumberFormat = "0"
Range("G2" & ":" & "G" & dercell).NumberFormat = "m/d/yyyy"
Columns("A:K").Sort key1:=Range("J2"), Header:=xlYes
End With
End Sub |
Lenteur d'exécution de codes.
Répondre avec citation
Partager