Supprimer les doublons d'une table sans clé

Commenter

Contenu du snippet

Il peut souvent nous arriver de supprimer les doublons d'une table qui n'a pas de clé. Ce qui fait que lorsque l'on supprimer les lignes contenant une valeur dédoublée, on peut totatelement supprimer les lignes contenant cette même valeur de la table sans pour autant en garder une.
Ce programme permettra par exemple s'il ya 4 lignes sur la table qui contiennent les mêmes valeurs de supprimer les 3 lignes et d'en garder une.

Source / Exemple : 


Public UnObjectConnexion As ADODB.Connection
Public ChaineDeConnexion As String

'Créer un bonton de commande ayant pour nom "CmdExecuter"
Private Sub CmdExecuter_Click()
Dim Resultat As Boolean
Dim UnRsSelection As ADODB.Recordset
Dim uneRequeteLigne As String
Dim UneRequeteSelection As String
Dim unRsligne As ADODB.Recordset
Dim Champ1, Champ2, Champ3, ChampDeRecherche As String
Set unRsligne = New ADODB.Recordset
Set UnRsSelection = New ADODB.Recordset
'Cette requête permet de sélectionner les lignes de la table pour lesquelles la valeur "UnChampDeRecherche" apparait sur 2 ligne au moins

UneRequeteSelection = "SELECT UnChampDeRecherche, COUNT(UnChampDeRecherche) FROM Un_Nom_de_table GROUP BY UnChampDeRecherche HAVING COUNT(UnChampDeRecherche) > 1"
'Paramétrer cette chaîne de connexion à votre guise pour accéder à votre base de données
'ici j'utilise une chaine de Connexion ODBC qui se connecte à une base de données SQL SERVER
ChaineDeConnexion = "Provider=MSDASQL;DSN=dsnEffacerDoublons;DATABASE=BdEffacerDoublons;UID=sa; PWD="

'fait appel à la procédure d'ouverture de connexion, située plus bas
'en paramètre un booléen pour tester si la connexion s'est bien déroulée
Call OuvertureConnexion(UnObjectConnexion, GlChaineDeConnexion, Resultat)
UnRsSelection.Open UneRequeteSelection, UnObjectConnexion, adOpenStatic, adLockReadOnly
'boucler sur les lignes ayant des doublons
    While Not UnRsSelection.EOF And UnRsSelection.BOF
        uneRequeteLigne = "SELECT UnChampDeRecherche,Champ1,Champ2,Champ3 FROM Un_Nom_de_table WHERE UnChampDeRecherche='" & UnRsSelection("UnChampDeRecherche") & "'"
        unRsligne.Open uneRequeteLigne, UnObjectConnexion, adOpenStatic, adLockReadOnly
        RaisonSocial = unRsligne("RaisonSociale")
        'ranger Une valeur de ligne dans des variables
        ChampDeRecherche = unRsligne("UnChampDeRecherche")
        Champ1 = unRsligne("Champ1DeLaTable")
        Champ2 = unRsligne("Champ2DeLaTable")
        Champ3 = unRsligne("Champ3DeLaTable")
        'Supprimer ttes les lignes de doublons
        UnObjectConnexion.Execute "DELETE FROM Un_Nom_de_table WHERE UnChampDeRecherche='" & ChampDeRecherche & "'"
        'Insérer une ligne unique
        UnObjectConnexion.Execute "INSERT INTO Un_Nom_de_table VALUES ('" & ChampDeRecherche & "', '" & Champ1 & "', '" & Champ2 & "','" & Champ3 & "')"
        'fermeture du recordset
        unRsligne.Close
        UnRsSelection.MoveNext
    Wend
MsgBox "Traitement effectué avec succès"
Call FermetureConnexion(UnObjectConnexion, Resultat)
Unload Me
End Sub

Public Sub OuvertureConnexion(ByRef objconnexion As ADODB.Connection, ByVal ChaineConnexion As String, ByRef Resultat As Boolean)

        On Error GoTo ErreurOuvertureConnexion
        Set objconnexion = New ADODB.Connection
        objconnexion.CommandTimeout = 960
        objconnexion.Open ChaineConnexion
        Resultat = True

ExitOuvertureConnexion:
    Exit Sub

ErreurOuvertureConnexion:
    Resultat = False
    MsgBox Err.Number
    MsgBox "Erreur d'ouverture de Connexion..." & "Chaine = " & ChaineConnexion & "..." & Err.Description & " " & Err.Number
    GoTo ExitOuvertureConnexion
End Sub

Sub FermetureConnexion(ByRef objconnexion As ADODB.Connection, ByRef Bsucces As Boolean)

On Error GoTo ErreurFermetureConnexion
    Bsucces = False
    If Not objconnexion Is Nothing Then
        Set objconnexion = Nothing
        Bsucces = True
    End If
ExitFermetureConnexion:
    Exit Sub
ErreurFermetureConnexion:
    MsgBox "Erreur fermeture de Connexion..." & Err.Description
    GoTo ExitFermetureConnexion
End Sub

Conclusion :


Ciao et à bientôt pour d'autres sources

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_rahou)