Bonjour à tous!

Je me heurte à un problème concernant une table comportant les colonnes "DateOpe" (format: "jj/mm/aaaa hh:nn:ss") ,"Débit", "Crédit", "Solde". La colonne "DateOpe" pouvant, en fonction des traitements, recevoir des valeurs en doublons. Bien entendu lors du calcul du solde en date, cela fausse les calculs.

J'ai donc développé la routine récursive suivante en VBA afin de corriger cela en rajoutant une minute à toutes les dates en double.

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
Sub MAJDoublonsDates411()
          Dim StrSQL As String, mabd As Database, MRec As Recordset, MRec2 As Recordset, Crit As String, DteCurr As String, Dte2Compare As Date
          Set mabd = CurrentDb()
          StrSQL = "SELECT CPTE_CAISSE_Cli.CCDat, CPTE_CAISSE_Cli.CCCpt " & _
                              "From CPTE_CAISSE_Cli " & _
                              "WHERE CPTE_CAISSE_Cli.CCDat In (SELECT [CCDat] FROM [CPTE_CAISSE_Cli] As Tmp GROUP BY [CCDat] HAVING Count(*)>1 ) " & _
                              "ORDER BY CPTE_CAISSE_Cli.CCDat;"
 
StartHere:
          Set MRec = mabd.OpenRecordset(StrSQL)
          With MRec
                    Do While .EOF = False
                              .MoveFirst
                              DteCurr = Format(!CCDat, "yyyymmddhhnnss")
                              Dte2Compare = !CCDat
                              Crit = "format(CCDat,'yyyymmddhhnnss')=" & DteCurr
                              StrSQL = "SELECT CCDat, CCLib FROM CPTE_CAISSE_Cli WHERE " & Crit & " ORDER BY CCDat;"
                              Set MRec2 = mabd.OpenRecordset(StrSQL)
                              Do While MRec2.EOF = False
                                        MRec2.Edit
                                        Dte2Compare = IIf(MRec2!CCLib = "REPORT", DateAdd("n", -1, Dte2Compare), DateAdd("n", 1, Dte2Compare))
                                        MRec2!CCDat = Dte2Compare
                                        MRec2.Update
                                        MRec2.MoveNext
                              Loop
                              MRec2.Close
                              StrSQL = "SELECT CPTE_CAISSE_Cli.CCDat, CPTE_CAISSE_Cli.CCCpt " & _
                                                  "From CPTE_CAISSE_Cli " & _
                                                  "WHERE CPTE_CAISSE_Cli.CCDat In (SELECT [CCDat] FROM [CPTE_CAISSE_Cli] As Tmp GROUP BY [CCDat] HAVING Count(*)>1 ) " & _
                                                  "ORDER BY CPTE_CAISSE_Cli.CCDat;"
                             .Close
                             GoTo StartHere
                    Loop
          End With
End Sub
Le souci est que cela est trèèèès long à s'exécuter. Serait-il possible d'imaginer une requête SQL pouvant se charger du problème (pour ma part j'avoue que je cale ) ?

Je vous en remercie d'avance.