Supprimer les doublons d'une table (vba access)

Soyez le premier à donner votre avis sur cette source.

Snippet vu 47 235 fois - Téléchargée 29 fois

Contenu du snippet

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

A voir également

Ajouter un commentaire

Commentaires

Messages postés
23
Date d'inscription
lundi 16 janvier 2006
Statut
Membre
Dernière intervention
3 décembre 2007

PS : J'ai collé tout ceci dans un nouveau module d'access.
Messages postés
23
Date d'inscription
lundi 16 janvier 2006
Statut
Membre
Dernière intervention
3 décembre 2007

Bonjour,
J'ai un gros problème avec les doublons et j'ai trouvé ton code seulement je connais absolument rien en VB.
voila ce que j'ai écrit
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 "date"
add "GPSX"
add "GPSY"

'Puis on enlève
EneleverDoublons "Tb_Horaire_Enr_AVG"
MsgBox "terminé"
End Sub


Private Sub add(champ As String, Optional typ As String = "")
If champ <> "date" 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 " & définitive & " 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 " & définitive & " where " & where
CurrentDb.Execute "insert into " & définitive & " values(" & valeur & ")"
rst.MoveNext
Wend
End Sub
Voila j'ai une table avec quatre colonne sans clés primaire. et je ne dois jamais avoir 2 fois les même coordonnée pour 1 jour. donc mes trois première colonne sont "date" "GPSX" et "GPSY" ce que j'ai mis ci-dessus. Et le nom de ma table est définitive.
Problème lorque que je veux tester si cela fonction il me dit d'enregistrer le macro. Je mets un nom et aprés jai Sub lenomdumacro et endsub. Pouvez me guider pour faire fonctionner votre code ? sachant que je travaille sous access 2003.
Merci beaucoup, je suis ouvert à toute autre proposition pour supprimer mes doublons.
Bonne journée
Messages postés
2336
Date d'inscription
samedi 14 juillet 2001
Statut
Membre
Dernière intervention
5 mai 2009
5
une table de liaison est habituellement ce qui est utilisé
Messages postés
21
Date d'inscription
jeudi 22 septembre 2005
Statut
Membre
Dernière intervention
17 avril 2019

Je trouve cette discussion pour le moins intéressante, et j'ai un cas typique de doublons à supprimer qui ne peut pas ne pas se générer grâce à une indexation unique.

Soit une relation plusieurs à plusieurs en Access. Il me faut définir plusieurs points pouvant chacun se trouver dans différents secteurs. Chaque secteur peut, lui aussi, contenir différents points. Dans la table de points, le numéro de point est indexé sans doublons. Dans la table de secteurs, le numéro de secteurs est indexé sans doublons.
Je pense que même les super diplômés seront d'accord avec moi qu'en Access il n'y a pas moyen d'éviter la table intermédiaire indexée avec doublons pour reprendre le numéro de point versus les différents numéros de secteurs et inversement.

Régulièment, des importations externes doivent être faites parce que des fournisseurs externent envoient des données à introduire.
Il se peut donc que des doublons se créent dans la table intermédiaire, le même point étant dès lors lié plusieurs fois au même secteur. Ceci engendrant bien entendu des erreurs de comptage de point par secteur, pour reprendre un exemple trè simple.

La suppression de doublons me paraît fort intéressant, du moins dans ce cas particulier.

Si toutefois quelqu'un à la clé qui permettrait de crééer des liaisons plusieurs à plusieurs, et donc d'éviter les tables intermédiaires, je suis preneur.

@+
Jean-Marc
Messages postés
2336
Date d'inscription
samedi 14 juillet 2001
Statut
Membre
Dernière intervention
5 mai 2009
5
tu pourrais ajouter des [ ] autour des champs, tu dois avoir certains champs qui ont la même écriture qu'un mot réservé, genre var, mid, sql, ...
Afficher les 29 commentaires

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.