Voici un petti code très simple qui permet de suppimer totu les doublons dans une table pour avoir seulement 1 fois les valeurs
Ceci vérifie réellement les doublons, puisqu'une seule valeur est différente, alors toute la ligne est considéré comme pas doublé
l'astuce est de détecter les doublons, puis les supprimer et ré-écrire la ligne, mais non doublé
tout le code doit-être dans un module dans la base de donnés access
Source / Exemple :
Option Compare Database
Option Explicit
Dim tableau() As String
Dim typeChamps() As String
Private Sub Tb_Horaire_Enr_AVG()
'initlise les tableaux
ReDim tableau(0)
ReDim typeChamps(0)
'On écris les champs de la requête
add "id"
add "Avg"
add "HeureDebut", "#"
add "HeureFin", "#"
add "commentaire"
'Puis on enlève
EneleverDoublons "Tb_Horaire_Enr_AVG"
MsgBox "teminé"
End Sub
Private Sub Tb_Horaire_Enr_AVG_calculer()
ReDim tableau(0)
ReDim typeChamps(0)
add "id"
add "date", "#"
add "Job"
add "Employe"
add "Avg"
add "QTE", "'"
EneleverDoublons "Tb_Horaire_Enr_AVG_calculer"
MsgBox "teminé"
End Sub
Private Sub Tb_Horaire_Enr_Employe()
ReDim tableau(0)
ReDim typeChamps(0)
add "id"
add "Employe"
add "Avg"
add "Edebut", "#"
add "Efin", "#"
add "Sdebut", "#"
add "Sfin", "#"
add "commentaire"
add "payer", "bool"
add "tempPayé", "#"
add "valider", "bool"
add "salaire"
add "prime40Hrs"
EneleverDoublons "Tb_Horaire_Enr_Employe"
MsgBox "teminé"
End Sub
Private Sub add(champ As String, Optional typ As String = "")
If champ <> "id" Then
ReDim Preserve tableau(UBound(tableau) + 1)
ReDim Preserve typeChamps(UBound(typeChamps) + 1)
End If
tableau(UBound(tableau)) = champ
typeChamps(UBound(typeChamps)) = typ
End Sub
Private Sub EneleverDoublons(table As String)
Dim rst As Recordset
Dim i As Integer
Dim champs As String
Dim where As String
Dim valeur As String
'On construit la requete
For i = 0 To UBound(tableau)
champs = champs & " , " & tableau(i)
Next i
champs = Mid(champs, 4)
Set rst = CurrentDb.OpenRecordset("select count(*)," & champs & " from " & table & " GROUP BY " & champs & " having count(*) > 1")
While Not rst.EOF
where = ""
valeur = ""
For i = 0 To UBound(tableau)
If typeChamps(i) = "bool" Then
where = where & " and " & tableau(i) & " = " & IIf(rst(i + 1).Value, "true", "false")
valeur = valeur & "," & IIf(rst(i + 1).Value, "true", "false")
Else
If IsNull(rst(i + 1).Value) Then
where = where & " and " & tableau(i) & " = null"
valeur = valeur & ",null"
Else
where = where & " and " & tableau(i) & " = " & typeChamps(i) & rst(i + 1).Value & typeChamps(i)
valeur = valeur & "," & typeChamps(i) & rst(i + 1).Value & typeChamps(i)
End If
End If
Next i
where = Mid(where, 6)
valeur = Mid(valeur, 2)
CurrentDb.Execute "delete * from " & table & " where " & where
CurrentDb.Execute "insert into " & table & " values(" & valeur & ")"
rst.MoveNext
Wend
End Sub
Conclusion :
on envoi aussi bool pour les valeur boolean et # ou ' pour envoyer au bon format dans la base de donnée lors de la ré-écriture de la ligne
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.