2/5 (29 avis)
Snippet vu 50 120 fois - Téléchargée 31 fois
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
20 nov. 2007 à 06:59
20 nov. 2007 à 06:58
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
27 sept. 2007 à 22:42
27 sept. 2007 à 17:39
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
28 juin 2007 à 15:27
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.