Autres Rapidité Dictionnaire et Find

[Calvus]

Bonjour le forum,

J'ai une macro me permettant de chercher des occurrences si elles existent dans une autre feuille.
Le code s'exécute en 0,44 s

Le problème est si je tente de repérer la ligne trouvée.
Là le temps passe à 2,8 s

Le problème est dû à Find qui prend trop de temps. J'ai mis un repère dans le code pour visualiser directement la ligne.
Quel serait l'autre moyen de conserver la rapidité de mon dictionnaire ? Une boucle peut être ? Tiens je vais essayer.

Pour exemple, vous pouvez remplacer B2 en feuille 2 par A111

La macro recherche la colonne E de la feuille 2(12) dans la feuille 1.

La seconde macro(Test2) zappe simplement la recherche pour calcul de la différence de temps. Le code est le même.

Option Explicit


Sub Test_Prospects_Existants()
    With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With
Dim f As Worksheet, mondico, BD(), tablo, i As Integer, start As Single
start = Timer
Set f = ActiveSheet
Set tablo = f.Range("E3:E" & f.Range("E" & Rows.Count).End(3).Row)
BD = tablo.Value
Set mondico = CreateObject("Scripting.Dictionary")
    mondico.CompareMode = vbTextCompare
        For i = LBound(BD) To UBound(BD)
            If Not mondico.Exists(BD(i, 1)) Then mondico.Add Cells(i + 2, 5), Cells(i + 2, 9)
        Next

Dim c, j As Integer, a, k

ReDim a(1 To UBound(BD), 1 To UBound(BD))
    For i = 6 To Feuil1.Cells(Rows.Count, 5).End(xlUp).Row
For Each c In mondico.keys
' LENTEUR ICI
k = Range("e:e").Find(c).Address
            For j = 9 To 9
                If Feuil1.Cells(i, j) = mondico(c) And Feuil1.Cells(i, j - 4) = c Then
MsgBox "Prospect existant ! " & Chr(10) & c & Chr(10) & k
MsgBox "durée du traitement: " & Timer - start & " secondes"
Set mondico = Nothing
Exit Sub
        i = i + 1
        Exit For
                End If
           
            Next j
Next c
    Next i
Set mondico = Nothing

        With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With
MsgBox "durée du traitement: " & Timer - start & " secondes"
End Sub

Merci et bonne journée.

 

[Dranreb]

Bonjour.
Au lieu de charger en Tablo seulement la colonne E, chargez donc toutes les colonnes qu'il vous faut et n'utilisez plus du tout Cells. Dans le MonDico rangez selement les numéros de lignes, comme ça vous accéderez instantanément à tout ce que vous voudrez dans Tablo.

 

[Calvus]

Bonjour Dranreb,

Ok merci, je vois le principe, mais concrètement comment j'écris ça ?

Set tablo = f.Range("B3:S" & f.Range("E" & Rows.Count).End(3).Row)

Mais après, pour trouver mes données ?

 

[BOISGONTIER]

Bonjour,

Objet dictionary

Objet dictionary

Boisgontier

 

[Dranreb]

If Not mondico.Exists(BD(i, 4)) Then mondico.Add BD(i, 4), i

 

[Calvus]

Ok merci à vous deux.
J'adapte et reviens vous dire.

Bonne journée.

 

[Calvus]

Bonsoir,

Alors j'ai réussi à gagner 1 seconde, mais ce n'est pas encore ça.
Toujours cette ligne qui pose problème je pense :
k = Range("e:e").Find(c).Address
Mais je ne parviens pas à la remplacer. c.Address ou c.Row ne fonctionnant pas.
Comment faire ?

Je ne suis peut être pas tout à fait au point avec le dico non plus, bien que j'y ai passé des heures..

Sub Test_Prospects_Existants()
    With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With
Dim f As Worksheet, mondico, BD(), tablo, i As Integer, start As Single
start = Timer
Set f = ActiveSheet

Set tablo = f.Range("B3:S" & f.Range("E" & Rows.Count).End(3).Row)
BD = tablo.Value
Set mondico = CreateObject("Scripting.Dictionary")
    mondico.CompareMode = vbTextCompare
        For i = LBound(BD) To UBound(BD)
            If Not mondico.Exists(BD(i, 4)) Then mondico.Add BD(i, 4), BD(i, 8)

        Next

Dim c, j As Integer, a, k
 
 ReDim a(1 To UBound(BD), 1 To UBound(BD))
For Each c In mondico.keys
    For i = 1 To Feuil1.Cells(Rows.Count, 5).End(xlUp).Row

' LENTEUR ICI
'        Debug.Print BD(i, 4)
k = Range("e:e").Find(c).Address
            For j = 9 To 9
                If Feuil1.Cells(i + 5, j) = mondico(c) And Feuil1.Cells(i + 5, j - 4) = c Then
MsgBox "Prospect existant ! " & Chr(10) & c & Chr(10) & k
MsgBox "durée du traitement: " & Timer - start & " secondes"
Set mondico = Nothing
Exit Sub
        i = i + 1
        Exit For
                End If
            
            Next j
    Next i
Next c
Set mondico = Nothing

        With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With
MsgBox "durée du traitement: " & Timer - start & " secondes"
End Sub

@BOISGONTIER
J'ai essayé le code de ton classeur (recherche adresse), mais j'obtiens une valeur vide sur 2. Je n'ai pas su adapter..
Je peux mettre le code demain si tu veux.

Merci

 

[Dranreb]

Mais bonsang pourquoi ne notez vous pas le numéro de ligne dans votre dico ? Vous ne seriez alors plus obligé de la chercher cette ligne puisque vous l'auriez directement !

 

[Calvus]

Ça c'est une bonne idée !
Je fais comment ?

 

[Dranreb]

j'ai indiqué l'instruction au poste #5

 

[Calvus]

Alors, en effet je n'avais pas vu le i à la fin de la ligne.

En revanche, j'ai besoin de 2 valeurs dans mon dico, + la ligne.

If Not mondico.Exists(BD(i, 4)) Then mondico.Add BD(i, 4), BD(i, 8), i
ne fonctionne pas.

Et
If Not mondico.Exists(BD(i, 4)) Then mondico.Add BD(i, 4), i
ne me trouve pas l'occurrence.

 

[Dranreb]

Pas besoin: si vous retrouvez i dans le dico vous retrouvez aussi BD(i, 8)

 

[Calvus]

Bon je n'y arrive pas. Tant pis, je verrai ça demain à nouveau.
Merci

 

[Dranreb]

Vous chercher à obtenir quoi au juste ?
Peut être que ce serait plus simple avec mon complément GigIdx.xlam.

 

[Calvus]

Ou la ! J'ai de la lecture là.

Vous chercher à obtenir quoi au juste ?

Au départ seulement à accélérer la procédure.
Et la manip, vérifier qu'une valeur colonnes E et I sont présentes ou non dans la feuille Général. Si c'est le cas, afficher un Msgbox avec le numéro de ligne.
Tout ça fonctionne, c'est juste un peu lent à cause de Find. J'aurais donc simplement aimé remplacer la ligne de code Find(c).
C'est tout.