Comparer 2 colonnes ADODB vs Dictionnaire

**tototiti2008** · 23/11/2012, 11h32

Bonjour Oliv,

Oui, j'avais fini par trouver le même lien

Pour l'ordre, mystère et boule de gomme, je ne sais pas pourquoi il dégrade l'ordre original des données sans qu'on mette un ORDER BY, on dirait qu'il retourne en premier les enregistrements qui correspondent à travers la relation (join) mais je ne sais pas pourquoi...

, surtout qu'il le fait pour la deuxième requête mais pas pour la première chez moi...

Re,

J'ai regardé ta dernière version déjà très rapide, et je me suis permis de la modifier légèrement pour n'utiliser qu'un dictionnaire, encore un tout petit peu plus rapide il me semble

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Sub DictionnaireV2_1()
    Dim T As Double, i As Long
    Dim mondico As Object
    Dim TabloS1 As Variant
    Dim TabloS2 As Variant
    T = Timer
    Set mondico = CreateObject("Scripting.Dictionary")
 
    If Worksheets("Feuil2").UsedRange.Rows.Count < Worksheets("Feuil1").UsedRange.Rows.Count Then
        Set S2 = Worksheets("Feuil1")
        Set S1 = Worksheets("Feuil2")
    Else
        Set S1 = Worksheets("Feuil1")
        Set S2 = Worksheets("Feuil2")
    End If
    S1.Columns("B:B").ClearContents
    S2.Columns("B:B").ClearContents
 
 
    TabloS1 = Range(S1.Range("A1"), S1.Cells(Rows.Count, 1).End(xlUp).Offset(0, 1)).Value
    TabloS2 = Range(S2.Range("A1"), S2.Cells(Rows.Count, 1).End(xlUp).Offset(0, 1)).Value
 
    For i = 1 To UBound(TabloS1, 1)
        mondico(TabloS1(i, 1)) = i
    Next i
 
    For i = 1 To UBound(TabloS2, 1)
        If mondico.Exists(TabloS2(i, 1)) Then
            TabloS2(i, 2) = "OK"
            TabloS1(mondico.Item(TabloS2(i, 1)), 2) = "OK"
        Else
            TabloS2(i, 2) = "ko"
        End If
    Next i
 
    For i = 1 To UBound(TabloS1, 1)
        If TabloS1(i, 2) = "" Then
            TabloS1(i, 2) = "ko"
        End If
    Next i
 
Debug.Print Timer - T
Debug.Print mondico.Count
    Application.ScreenUpdating = False
    S1.Range("A1:b" & UBound(TabloS1)) = TabloS1
 
    S2.Range("A1:b" & UBound(TabloS2)) = TabloS2
    Application.ScreenUpdating = True
Debug.Print Timer - T
    MsgBox Timer - T
End Sub

**patricktoulon** · 23/11/2012, 14h47

bonjour

oais!!??? ok mais je n'en vois toujour pas l'utilité

tu constatera que les variables tableaux sont aussi rapide que les variables dictionnaire

alors moi il me viens une reflection sans doute sui je bete mais pourquoi créer un dictionnaire alors que les deux tableaux sont deja créés
pourquoi ne pas comparer un tableaux a l'autre et meme pour le fun en créer un 3eme pour les noncommunset le rajouter a la suite

sa reduirais
les boucles
les variables
etc....

enfin moi ceque j'en dis

au plaisir

**tototiti2008** · 23/11/2012, 14h52

Bonjour Patrick,
Re,

tu constatera que les variables tableaux sont aussi rapide que les variables dictionnaire

Pour ce qui est des recherches d'une valeur dans un tableau, je crois (mais je peux me tromper

) que rien n'est aussi rapide que la méthode Exists des dictionnaires, si tu connais quelque chose de comparable, je suis preneur

J'ai essayé sans dictionnaire, et alors que la dernière version d'Oliv prenait environ 4 secondes chez moi, ma version sans dictionnaire prenait environ 60 secondes, si je me souviens bien, pas vraiment comparable, mais sans doute y a-t-il plus rapide que la méthode que j'avais utilisé (Application.Match)

**patricktoulon** · 23/11/2012, 15h02

re
ca n'est pas la methode exist que je remet en cause

mais le fait que tu boucle deja avant sur les tableaux et mon idée c'est que
la moulinette doit s'arreter a ses deux boucle

et il est impossible que 2 boucles sur 2 tableaux (.final )soit plus lente que 3boucle en testant en plus un dictionnaire

tu vois ce que je veux dire

ou alors vous avez de serieux probleme de librairie dans votre system

**tototiti2008** · 23/11/2012, 15h04

Re,

Après reflexion, s'il y a des doublons dans les n° SIREN, ma dernière version risque de ne pas fonctionner correctement, je pense qu'il faut en rester à la dernière version d'Oliv

mais le fait que tu boucle deja avant sur les tableaux et mon idée c'est que
la moulinette doit s'arreter a ses deux boucle

et il est impossible que 2 boucles sur 2 tableaux (.final )soit plus lente que 3boucle en testant en plus un dictionnaire

La question est comment tu vérifies, en ne bouclant que sur les 2 tableaux, que la valeur existe dans l'autre. C'est quand même le but de cette macro de savoir si ça existe ou pas...

Encore une fois, si tu vois une autre méthode que Exists du dictionnaire, qui n'est pas une boucle supplémentaire et qui a des performances comparables, je prend

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ou alors vous avez de serieux probleme de librairie dans votre system

Mais je n'ai peut-être pas les mêmes références de cochées que toi

**Oliv-** · 23/11/2012, 15h17

Envoyé par tototiti2008

Re,

Après reflexion, s'il y a des doublons dans les n° SIREN, ma dernière version risque de ne pas fonctionner correctement, je pense qu'il faut en rester à la dernière version d'Oliv

Je confirme , c'est ce que je viens de tester effectivement !

**tototiti2008** · 25/11/2012, 16h33

Bonjour à tous,

une version qui gère les doublons avec un seul dictionnaire

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
Sub DictionnaireV2_2()
    Dim T As Double, i As Long, j As Long
    Dim mondico As Object
    Dim TabloS1 As Variant
    Dim TabloS2 As Variant
    Dim TabloLigne
    T = Timer
    Set mondico = CreateObject("Scripting.Dictionary")
 
    If Worksheets("Feuil2").UsedRange.Rows.Count < Worksheets("Feuil1").UsedRange.Rows.Count Then
        Set S2 = Worksheets("Feuil1")
        Set S1 = Worksheets("Feuil2")
    Else
        Set S1 = Worksheets("Feuil1")
        Set S2 = Worksheets("Feuil2")
    End If
    S1.Columns("B:B").ClearContents
    S2.Columns("B:B").ClearContents
 
 
    TabloS1 = Range(S1.Range("A1"), S1.Cells(Rows.Count, 1).End(xlUp).Offset(0, 1)).Value
    TabloS2 = Range(S2.Range("A1"), S2.Cells(Rows.Count, 1).End(xlUp).Offset(0, 1)).Value
 
    For i = 1 To UBound(TabloS1, 1)
        If mondico.exists(TabloS1(i, 1)) Then
            mondico(TabloS1(i, 1)) = mondico(TabloS1(i, 1)) & "," & i
        Else
            mondico(TabloS1(i, 1)) = CStr(i)
        End If
    Next i
 
    For i = 1 To UBound(TabloS2, 1)
        If mondico.exists(TabloS2(i, 1)) Then
            TabloS2(i, 2) = "OK"
            TabloLigne = Split(mondico.Item(TabloS2(i, 1)), ",")
            For j = LBound(TabloLigne) To UBound(TabloLigne)
                TabloS1(CLng(TabloLigne(j)), 2) = "OK"
            Next j
        Else
            TabloS2(i, 2) = "ko"
        End If
    Next i
 
    For i = 1 To UBound(TabloS1, 1)
        If TabloS1(i, 2) = "" Then
            TabloS1(i, 2) = "ko"
        End If
    Next i
 
Debug.Print Timer - T
Debug.Print mondico.Count
    Application.ScreenUpdating = False
    S1.Range("A1:b" & UBound(TabloS1)) = TabloS1
 
    S2.Range("A1:b" & UBound(TabloS2)) = TabloS2
    Application.ScreenUpdating = True
Debug.Print Timer - T
    MsgBox Timer - T
End Sub

**patricktoulon** · 25/11/2012, 16h44

bonjour toti

oui mais je n'arrive toujour pas a comprendre pourquoi et encore la on a un bon exemple

tu boucle sur les tableaux et dictionnaire plusieur fois

il suffit de prendre le plus grand rows.count et le comparer au plus petit avec un dictionnaire si veux
et pourquoi pas changer la clé de l'item pour les communs

j'ai fait plusieur essais avec des dicos et effectivement ils sont plus rapide alors elimines les tableaux tout du moins dans la moulinette

au plaisir

**tototiti2008** · 25/11/2012, 17h10

Bonjour Patrick,

oui mais je n'arrive toujour pas a comprendre pourquoi et encore la on a un bon exemple

Ben oui, mais moi je ne comprend pas pourquoi tu ne comprends pas

tu boucle sur les tableaux et dictionnaire plusieur fois

Il faut bien boucler sur le premier tableau pour remplir le dictionnaire
Il faut bien boucler sur le second pour voir si le n° SIREN existe dans le dictionnaire
La dernière boucle remplit les vides pour le 1er tableau, il y a peut-être moyen de la simplifier... mais je ne vois pas trop

**patricktoulon** · 25/11/2012, 19h24

re
essaie ca

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Sub DictionnaireV3()
Dim k1, k2, i1, i2
Set mondico = Nothing
    Set mondico2 = Nothing
Set mondico = CreateObject("Scripting.Dictionary")
Set mondico2 = CreateObject("Scripting.Dictionary")
If Sheets(1).UsedRange.Rows.Count > Sheets(2).UsedRange.Rows.Count Then
fin = Sheets(1).UsedRange.Rows.Count
Else
fin = Sheets(2).UsedRange.Rows.Count
End If
   'on a pris le plus grand nombre de lignes utilisé pour les feuilles 1 et 2
    For i = 2 To fin
     mondico.Add Sheets(1).Cells(i, 1).Value, Sheets(1).Cells(i, 2).Value 'avec les clés en colonne A, les valeurs en colonne B
     mondico2.Add Sheets(2).Cells(i, 1).Value, Sheets(2).Cells(i, 2).Value 'avec les clés en colonne A, les valeurs en colonne B
    Next
 
  k1 = mondico.keys
 i1 = mondico.items
 k2 = mondico2.keys
 i2 = mondico2.items
 
     For n = 0 To mondico.Count - 1
If mondico2.exists(k1(n)) Then
'ici ton code que tu veux faire pour les communs moi je te met un msgbox qui te donne les ligne des feuilles1 et 2 ou se trouve les communs
'
'
'
MsgBox "les lignes communnes sont " & vbCrLf & "pour la feuill1 c'est la ligne :" & mondico.Item(k1(n)) & vbCrLf & "pour la feuill2 c'est la ligne :" & mondico2.Item(k1(n))
End If
    Next
MsgBox fini
end sub

**mercatog** · 25/11/2012, 19h43

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
    For i = 2 To fin
     mondico.Add Sheets(1).Cells(i, 1).Value, Sheets(1).Cells(i, 2).Value 'avec les clés en colonne A, les valeurs en colonne B
     mondico2.Add Sheets(2).Cells(i, 1).Value, Sheets(2).Cells(i, 2).Value 'avec les clés en colonne A, les valeurs en colonne B
    Next

C'est toujours plus rapide de parcourir les éléments d'une variable tableau que de boucler sur les cellules d'une feuille. Ce sont là les abc et pas besoin de chercher midi à 14h

**patricktoulon** · 25/11/2012, 19h53

bonsoir mercatog

je n'ai pas mis les tableau mais il va de soit

ca n'est pas la que je voulais qui regarde

et puis pas la peine non plus de boucler sur les cells pour faires des tableaux

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

tableau=range("a1:b" & X)

au plaisir

**mercatog** · 25/11/2012, 19h56

Envoyé par patricktoulon

et puis pas la peine non plus de boucler sur les cells pour faire des tableaux

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

tableau=range("a1:b" & X)

C'est aussi une évidence

**tototiti2008** · 25/11/2012, 21h16

Bonsoir Patrick, Bonsoir mercatog,

va faire un tour par la

Merci pour le lien, je connaissais
Mon dernier code n'utilise pas les dictionnaires de manière optimisée ?

C'est toujours plus rapide de parcourir les éléments d'une variable tableau que de boucler sur les cellules d'une feuille. Ce sont là les abc et pas besoin de chercher midi à 14h

C'est bien pour ça que le code d'Oliv le faisait, et que j'ai conservé ça dans mon adaptation de son code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

et puis pas la peine non plus de boucler sur les cells pour faires des tableaux

Oui, ça non plus on ne le faisait pas

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

TabloS1 = Range(S1.Range("A1"), S1.Cells(Rows.Count, 1).End(xlUp).Offset(0, 1)).Value

Mais merci de vos conseils

**patricktoulon** · 26/11/2012, 14h39

Bon je vois que je n'arrive pas à me faire comprendre depuis le début.
J'en ai presque l'impression d'être un crétin.

Alors voilà: quand je dis qu'il n'est pas nécessaire de boucler sur tableau puis sur dico, c'est que ce n'est pas la peine.
Exemple:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
 
Sub DictionnaireV3()
    T = Timer
    Dim k1, k2, i1, i2, n, i, fin, tablos1, tablos2
    Set mondico = Nothing
    Set mondico2 = Nothing
    Set mondico = CreateObject("Scripting.Dictionary")
    Set mondico2 = CreateObject("Scripting.Dictionary")
    If Sheets(1).Range("a" & Rows.Count).End(xlUp).Row > Sheets(2).Range("a" & Rows.Count).End(xlUp).Row Then
        fin = Sheets(1).Range("a" & Rows.Count).End(xlUp).Row
    Else
        fin = Sheets(2).Range("a" & Rows.Count).End(xlUp).Row
    End If
    tablos1 = Range(Sheets(1).Range("A1"), Sheets(1).Cells(fin, 2))
    tablos2 = Range(Sheets(2).Range("A1"), Sheets(2).Cells(fin, 2))
    'On a pris le plus grand nombre de lignes utilisé pour les feuilles 1 et 2
    For i = 1 To fin
        mondico.Add tablos1(i, 1), i                     'avec les clés en colonne A, les valeurs en colonne B
        mondico2.Add tablos2(i, 1), i                       'avec les clés en colonne A, les valeurs en colonne B
    Next
    k1 = mondico.keys
    i1 = mondico.items
    k2 = mondico2.keys
    i2 = mondico2.items
 
    For n = 0 To mondico.Count - 1
        If mondico2.exists(k1(n)) Then
            'MsgBox "les lignes communnes sont " & vbCrLf & "pour la feuill1 c'est la ligne :" & mondico.Item(k1(n)) & vbCrLf & "pour la feuill2 c'est la ligne :" & mondico2.Item(k1(n))
            tablos1(mondico.Item(k1(n)), 2) = "ok en lig : " & mondico2.Item(k1(n))
            tablos2(mondico2.Item(k1(n)), 2) = "ok en lig : " & mondico.Item(k1(n))
        Else
            tablos1(mondico.Item(k1(n)), 2) = "ko"
        End If
    Next
    Sheets(1).Range("A1:b" & fin) = tablos1
    Sheets(2).Range("A1:b" & fin) = tablos2

purée de purée de purée.

heu.... au plaisir

**Oliv-** · 26/11/2012, 15h16

Bonjour patrick,
Tu as de la suite dans les idées, il manque des lignes à ton code, mais surtout j'ai une erreur 457 "Cette clé est déjà associée à un élément de cette collection" sur la ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

        mondico.Add tablos2(i, 1), i

pour i = 9 , car c'est un doublon avec une ligne précédente !!!

la même chose quand i est supérieur au nombre de ligne non vide de FEUIL2

Attention à ton codage Sheets(1) l'index 1 n'est pas forcément sur la feuil1

**mercatog** · 26/11/2012, 15h17

Tu n'as pas pensé à la possibilité d'une donnée existante en feuille2 et absente de feuille1?

quand je dis qu'il n'est pas nécessaire de boucler sur tableau puis sur dico, c'est que ce n'est pas la peine.

Pour remplir les dicos, tu boucles bien sur les tableaux, non?

Enfin, tu auras besoin d'une autre boucle pour boucler sur les éléments de mondico2 (cf ma remarque plus haut)

Bon je vois que je n'arrive pas à me faire comprendre depuis le début.

Ou bien parce que tu as compris autre chose que les intervenants qui ont précédés.

**patricktoulon** · 26/11/2012, 15h29

Chez moi sur 50000 lignes pour le test je n'ai aucune erreur.

Ensuite pour le test de l'un dans l'autre et l'autre dans l'un, dans la SEULE BOUCLE DICO.

AU LIEU DE BOUCLER SUR UBOUND(MONDICO) tu boucles sur la variable "fin" qui est la base et tu ajoutes la même condition que:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
if mondico2.exist 
if mondico.exists 'ici tu inverses les dico et tablo

et tu ajoutes l'inverse dans le "else" aussi.

Tu aura tes "ko" et "ok" partout sur les deux sheets.

Et oui j'ai de la suite dans les idées car depuis le début je suis persuadé qu'une seule boucle suffit pour la comparaison.

**mercatog** · 26/11/2012, 15h36

@patricktoulon
Je ne vois pas de "ko" en 2ème feuille

Car ça se peut qu'une donnée soit présente dans la feuille avec peu de ligne et absente de la feuille avec plus de données.

C'est comme comparer les poissons d'eau douce et ceux marins.

je te propose de relire le sujet initial. ça serait mieux pour tous.

**Oliv-** · 26/11/2012, 15h39

Voici une version corrigée de mon code car j'avais une erreur en cas de doublons dans TabloS2 :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Sub DictionnaireV2()
    Dim T, truc, temp, i
    Dim mondico As Object
    Dim mondicoCommun As Object
    T = Timer
    Set mondico = CreateObject("Scripting.Dictionary")
    Set mondicoCommun = CreateObject("Scripting.Dictionary")

    Set s1 = Worksheets("Feuil1")
    Set S2 = Worksheets("Feuil2")

    If S2.UsedRange.Rows.Count < s1.UsedRange.Rows.Count Then
        Set SR = s1
        Set s1 = S2
        Set S2 = SR
        Set SR = Nothing
    End If

    Dim TabloS1 As Variant
    Dim TabloS2 As Variant

    TabloS1 = Range(s1.Range("A1"), s1.Cells(Rows.Count, 1).End(xlUp).Offset(0, 1))
    TabloS2 = Range(S2.Range("A1"), S2.Cells(Rows.Count, 1).End(xlUp).Offset(0, 1))

    For i = 1 To UBound(TabloS1, 1)
        If Not mondico.Exists(TabloS1(i, 1)) Then mondico.Add TabloS1(i, 1), TabloS1(i, 1)
    Next i

    For i = 1 To UBound(TabloS2, 1)
        If mondico.Exists(TabloS2(i, 1)) Then
           If Not mondicoCommun.Exists(TabloS2(i, 1)) Then mondicoCommun.Add TabloS2(i, 1), TabloS2(i, 1)
            TabloS2(i, 2) = "OK"
        Else
            TabloS2(i, 2) = "ko"
        End If
    Next i

    For i = 1 To UBound(TabloS1, 1)
        If mondicoCommun.Exists(TabloS1(i, 1)) Then
            TabloS1(i, 2) = "OK"
        Else
            TabloS1(i, 2) = "ko"
        End If
    Next i

Debug.Print Timer - T
Debug.Print mondico.Count
Debug.Print mondicoCommun.Count
    Application.StatusBar = mondicoCommun.Count
    Application.ScreenUpdating = False
    s1.Range("A1:b" & UBound(TabloS1)) = TabloS1

    S2.Range("A1:b" & UBound(TabloS2)) = TabloS2
    Application.ScreenUpdating = True
Debug.Print "DictionnaireV2 :"; Timer - T
    MsgBox "DictionnaireV2 :" & vbCr & Timer - T

End Sub

Comparer 2 colonnes ADODB vs Dictionnaire [XL-2007]

Macros et VBA Excel

Discussions similaires

Partager

Partager