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 CreerTblDoublons()
Dim db As Database, r As DAO.Recordset, strSQL As String
Dim rDoublons As DAO.Recordset
Dim strCKey As String, strPKey As String
Dim strTable As String, strTblDoublons As String
strTable = "Table1"
strTblDoublons = strTable & "_Doublons"
DoCmd.SetWarnings False
DoCmd.RunSQL "SELECT TOP 1 Cle INTO [" & strTblDoublons & "] FROM [" & strTable & "]"
DoCmd.RunSQL "DELETE FROM [" & strTblDoublons & "]"
DoCmd.SetWarnings True
Set db = CurrentDb
strSQL = "SELECT Mois, Date, Rang, Cle " & _
"FROM [" & strTable & "] " & _
"ORDER BY Mois, Date, Rang, Cle"
Set r = db.OpenRecordset(strSQL, dbOpenForwardOnly)
Set rDoublons = db.OpenRecordset(strTblDoublons)
Do While Not r.EOF
strCKey = Format(r!mois, "00") & Format(r!Date, "00") & r!Rang
If strCKey = strPKey Then
rDoublons.AddNew
rDoublons!Cle = r!Cle
rDoublons.Update
End If
r.MoveNext
strPKey = strCKey
Loop
rDoublons.Close
r.Close
db.Close
End Sub |
Partager