Supprimer les doublons d'une table (vba access)

Commenter

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

S'inscrire maintenant

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.

Du même auteur (cs_dragon)