Rapport de message :*
 

Re: aide doublons vba

Titre du sujet : Re: aide doublons vba
par myDearFriend! le 21/10/2008 23:22:36

Bonsoir Irenee, bhbh,

bhbh, je suis comme toi, j'aime bien comprendre... aussi j'ai pris le temps de refaire des tests et je t'avoue que je ne comprends pas bien comment tu as réalisé les tiens ou alors, je n'ai rien compris au sujet !

Pour que les choses soient claires, voici le détail de ce que j'ai fait (je t'invite à reproduire la même chose et, le cas échéant, je tiens à ta disposition le classeur qui m'a servi de support) :

CONDITIONS DU TEST :

J'ai donc reproduit un classeur sur 41 000 lignes. Pour ces tests, j'ai repris les données de départ soit sur la plage B1:B6 :
Jean
Pierre
Jonas
Jean
Jacques
Jean
J'ai ensuite sélectionné cette plage B1:B6 et l'ai tirée vers le bas jusqu'à la ligne 41 000.

J'ai ensuite ajouté un Timer à ma procédure qui ressemble donc à ça :
Sub Test_mDF()
'myDearFriend!  -  www.mdf-xlpages.com
Dim C As Collection
Dim P As Range, R As Range
Dim L As Long

Dim T As Double
    T = Timer
    Application.ScreenUpdating = False
   
    Set C = New Collection
    With Sheets("Feuil1")       'A adapter
        L = .Cells(Application.Rows.Count, 2).End(xlUp).Row
        Set P = .Range(.Cells(1, 2), .Cells(L, 2))
    End With
    'Collecte de la liste d'éléments sans doublon
    On Error Resume Next
    For Each R In P
        If R.Text <> "" Then
            C.Add R.Text, R.Text
        End If
    Next R
    On Error GoTo 0
    P.Replace What:="", Replacement:="zzz", LookAt:=xlWhole 'Protection des éventuels éléments vides
    'Pour chaque élément, on affecte le code dans la colonne suivante
    For L = 1 To C.Count
        P.Replace What:=C(L), Replacement:="", LookAt:=xlWhole
        P.SpecialCells(xlCellTypeBlanks).Offset(0, 1).Value = L
        P.Replace What:="", Replacement:=C(L), LookAt:=xlWhole
    Next L
    P.Replace What:="zzz", Replacement:="", LookAt:=xlWhole 'Rétablissement des éléments vides
   
    Application.ScreenUpdating = True
    MsgBox Timer - T
End Sub

J'ajoute ensuite ta procédure dans laquelle j'insère le même Timer ainsi que l'utilisation de la propriété ScreenUpdating (pour aider à la comparaison) :
Sub Test_bhbh()
Dim MesNums As Object, Cel As Range

Dim T As Double
    T = Timer
    Application.ScreenUpdating = False
   
    Set MesNums = CreateObject("Scripting.Dictionary")
    For Each Cel In Range("B2:B" & [B65000].End(xlUp).Row)
        If Not MesNums.Exists(Cel.Value) Then
            MesNums.Add Cel.Value, Cells(Cel.Row, 1).Value
        Else
            temp2 = MesNums.items
            temp1 = MesNums.keys
            For i = 0 To MesNums.Count
                If temp1(i) = Cel.Value Then Cells(Cel.Row, 1).Value = temp2(i): Exit For
            Next i
        End If
    Next Cel
   
    Application.ScreenUpdating = True
    MsgBox Timer - T
End Sub
Comme pour ma procédure, le Timer ajouté ne nuit en rien à la vitesse d'exécution, mais permet de la formaliser.


LE TEST

- Je lance ma procédure une première fois :
Résultat : 16,539085 --> soit un peu plus de 16 secondes (un peu plus long que chez toi)
- J'efface la colonne C et je relance ma procédure une deuxième fois:
Résultat : 16,546875
- J'efface à nouveau la colonne C et relance une troisième fois :
Résultat : 16,546875 (exactement le même résultat que la 2ème fois)

- Je lance ta procédure une première fois :
Résultat : .... 405,7265625 (soit un peu plus de 5 minutes !!!)
- Pensant que la propriété ScreenUpdating pourrait peut-être avoir ici un effet négatif (ça arrive !), je la neutralise en effaçant les 2 lignes correspondantes et je relance une  deuxième fois ta procédure :
Résultat : 472,1640625 (soit plus de 7 minutes !!!)

J'ai pourtant pris soin de réaliser les deux séries de test strictement dans les mêmes conditions !

Autre remarque importante : chez moi, ta procédure ne met pas à jour les codes 1, 2, 3, etc... comme souhaité dans le sujet. La colonne A ainsi que la colonne C restent vierges.


Pour info : tests réalisés sous XL2003 - Portable Centrino - 1,20 Ghz - Windows Vista.

Cordialement,