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
| Option Compare Database
Option Explicit
Sub Compteur()
Dim SQLSelect As String
Dim SQLInsert As String
Dim SQLDelete As String
Dim oDB As DAO.Database
Dim oRS1 As DAO.Recordset
Dim oRS2 As DAO.Recordset
Dim straRow() As String
Dim strRow As String
Dim strTerminator As String
Dim lngNoDossier As Long
Dim strCodeProtocole As String
Dim strDateTraitement As String
Dim F As Integer
Dim intCounter As Integer
Dim sngStart!
Dim sngEnd!
Dim sngGap!
Dim L As Integer
Set oDB = CurrentDb
sngStart = Timer
'Création de la table vierge
On Error Resume Next
'On efface tout d'abord
SQLDelete = "DELETE * FROM Table_5FU_New;"
oDB.Execute SQLDelete
If Err <> 0 Then
'La table n'existe pas, on la créée
SQLSelect = "SELECT no_dossier, code_protocole, date_traitement, dose_administrée, libellé_commercial, 0 AS Compteur INTO Table_5FU_New FROM Table_5FU WHERE 1=0 ;"
oDB.Execute SQLSelect
oDB.TableDefs.Refresh
Err.Clear
End If
On Error GoTo L_ErrCompteur
'Tous les dossiers par date
SQLSelect = "SELECT no_dossier, code_protocole, date_traitement FROM Table_5FU GROUP BY no_dossier, code_protocole, date_traitement ORDER BY no_dossier, date_traitement;"
Set oRS1 = oDB.OpenRecordset(SQLSelect, dbOpenDynaset)
With oRS1
Do While Not .EOF
lngNoDossier = .Fields(0).Value
strCodeProtocole = .Fields(1).Value
strDateTraitement = Format(.Fields(2).Value, "dd/mm/yyyy")
'Debug.Print strCodeProtocole
intCounter = 0
'Tous les enregsitrements par quantité ASC
SQLSelect = "SELECT no_dossier, code_protocole, date_traitement, dose_administrée, libellé_commercial FROM Table_5FU WHERE no_dossier = " & lngNoDossier & " AND code_protocole = " & strCodeProtocole & " AND date_traitement = " & strDateTraitement & " ORDER BY dose_administrée ;"
Debug.Print SQLSelect
Set oRS2 = oDB.OpenRecordset(SQLSelect, dbOpenDynaset)
Debug.Print oRS2
With oRS2
Do While Not .EOF
L = L + 1
intCounter = intCounter + 1
SQLInsert = "INSERT INTO Table_5FU_New (no_dossier, code_protocole, date_traitement, dose_administrée, libellé_commercial, Compteur) "
SQLInsert = SQLInsert & "VALUES (" & .Fields(0).Value & ", " & .Fields(1).Value & ", " & .Fields(2).Value & ", " & .Fields(3).Value & ", '" & .Fields(4).Value & "', " & intCounter & ");"
Debug.Print SQLInsert
oDB.Execute SQLInsert, dbFailOnError
.MoveNext
Loop
.Close
intCounter = 0
End With
.MoveNext
Loop
.Close
End With
oDB.Close
sngEnd = Timer
sngGap = sngEnd - sngStart
MsgBox "Temps : " & Fix(sngGap) & " s.", , "Nombre de lignes :" & L
On Error GoTo 0
L_ExCompteur:
Set oRS2 = Nothing
Set oRS1 = Nothing
Set oDB = Nothing
Exit Sub
L_ErrCompteur:
MsgBox Err.Description, 48, Err.Source
Resume L_ExCompteur
End Sub |
Greffer un compteur sur des jeux d'enregistrements à valeurs communes par regroupement
Répondre avec citation
oups je vien de me rendre compte que j'ai oublier le plus important.... 1 correspond a la petite valeur et 2 a la grande. (ici 10 et 100 respectivement) 
Envoyé par IceCrime752
un UPDATE sera trop lourd, même si c'est faisable...
Partager