Autres Rapidité Dictionnaire et Find

Calvus

XLDnaute Barbatruc
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.

VB:
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.
 

Pièces jointes

  • Rapidité Dico 15.07.19.xlsm
    72 KB · Affichages: 23

Dranreb

XLDnaute Barbatruc
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

XLDnaute Barbatruc
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..

VB:
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
 

Calvus

XLDnaute Barbatruc
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.
 

Calvus

XLDnaute Barbatruc
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.
 

Discussions similaires

Réponses
12
Affichages
225
Réponses
11
Affichages
236

Membres actuellement en ligne

Statistiques des forums

Discussions
311 725
Messages
2 081 941
Membres
101 848
dernier inscrit
Djigbenou