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]

Alors constituez votre dictionnaire à partir d'un tableau pris de la feuille Général en prenant comme clé la concaténation Enseigne & Ville en y notant ce numéro de ligne. Ensuite parcourez un autre tableau pris de l'autre feuille et verifiez si la concaténation Enseigne & Ville de celle là existe dans le dico, et si oui le dico vous restitue le numéro de ligne dans Général.

 

[BOISGONTIER]

Comparaison FIND et DICO pour 100.000 lignes.
Le temps avec Dico est 10 fois inférieur.
Avec le dico,c'est la création de l'index qui prend du temps.

Sub essaiFind()  ' 3 secondes
  t = Timer
  clé = "Nom100000"
  For i = 1 To 100    ' 100 recherches
    Set result = [A2:A100001].Find(what:=clé)
  Next i
  MsgBox Timer - t
  MsgBox result.Offset(, 1).Value
End Sub

Sub essaiDico()  ' 0,25 secconde
  t = Timer
  Set d = CreateObject("scripting.dictionary")
  TblBD = [A2:B100001].Value
  For i = 1 To UBound(TblBD)   ' création de l'index
    d(TblBD(i, 1)) = i
  Next i
  clé = "Nom100000"
  For i = 1 To 100    ' 100 recherches
    pos = d(clé)
    ville = TblBD(pos, 2)
  Next i
  MsgBox Timer - t
  MsgBox ville
End Sub

Boisgontier

 

[Calvus]

Bonjour,

Merci Jacques !

Alors voici où j'en suis.
Le problème est réglé. En revanche, je ne sais pas si j'ai bien adapté et optimisé ton code. En attendant j'ai enfin compris ce que Dranreb voulait dire par "il faut noter le numéro de ligne".

Voici l'adaptation du code dans mon classeur (même structure que celui que j'ai posté)

Sub essaiDico()
Dim f As Worksheet, t As Single, d, TblBD, i As Integer, j As Integer, clé As String, pos As Integer, ville As String
t = Timer
Set f = ActiveSheet
Set f1 = Sheets("Général")
t1 = f1.Range("E6" & ":I" & f1.Range("E" & Rows.Count).End(xlUp).Row)

  Set d = CreateObject("scripting.dictionary")
  TblBD = f.Range("E3" & ":I" & f.Range("E" & Rows.Count).End(xlUp).Row).Value
  For i = 1 To UBound(TblBD)
    d(TblBD(i, 1)) = i
  Next i
  For i = 1 To UBound(TblBD)
  clé = Cells(i + 2, 5)
    For j = 1 To UBound(t1)
    pos = d(clé)
    nom = TblBD(pos, 1)
    ville = TblBD(pos, 5)
    If nom = t1(j, 1) And ville = t1(j, 5) Then
  MsgBox Format(Timer - t, "0.000") & " secondes"
    MsgBox t1(j, 1) & " " & t1(j, 5) & Chr(10) & "Ligne " & i + 2
    End If
  Next j
  Next i
End Sub

De mon coté, j'avais réglé le problème d'une autre manière, en passant par un tableau tout simplement.
En voici le code

Sub tablo()
Dim f As Worksheet, f1 As Worksheet, t, t1, i As Integer, j As Integer, start As Single
start = Timer

Set f = ActiveSheet
Set f1 = Sheets("Général")

t = f.Range("E3" & ":I" & f.Range("E" & Rows.Count).End(xlUp).Row)
t1 = f1.Range("E6" & ":I" & f1.Range("E" & Rows.Count).End(xlUp).Row)

    For i = 1 To UBound(t1)
        For j = 1 To UBound(t)
            If t1(i, 1) = t(j, 1) And t1(i, 5) = t(j, 5) Then
                    MsgBox "durée du traitement: " & Format(Timer - start, "0.000") & " secondes"
                MsgBox t1(i, 1) & Chr(10) & "Ligne " & j + 2
            End If
        Next j
    Next i

End Sub

Les temps des 2 codes sont plutôt similaires, bien que j'ai été très étonné de constater que les tableaux étaient plus rapides que le dictionnaire.
C'est pour ça que je dis que j'ai peut être mal adapté.
Dis moi ce que tu en penses.

Pour une occurrence trouvée
Ex temps tableau : 0,004 secondes
Ex temps dico : 0,051 secondes..

Dans tous les cas c'est 1000 fois mieux que mes 2,8 secondes d'hier...

A+

 

[BOISGONTIER]

Bonsoir,

-L'utilisation du dictionnaire index devient pertinente pour des tableaux de taille importante.
-J'ai repris la version tableau et je l'ai adapté avec un dictionnaire.Elle permet d'éviter la boucle For j=1 to Ubound(t)
Le temps est de 0,008 sec au lieu de 0,02 sec pour le tableau.

Sub tablo2()
  Dim f As Worksheet, f1 As Worksheet, t, t1, i As Integer, j As Integer, start As Single
  start = Timer
  Set f = ActiveSheet
  Set f1 = Sheets("Général")
  Set d = CreateObject("scripting.dictionary")
  t = f.Range("E3" & ":I" & f.Range("E" & Rows.Count).End(xlUp).Row)
  For i = 1 To UBound(t)     ' création index
    clé = t(i, 1) & "|" & t(i, 5)
    d(clé) = i
  Next i
  t1 = f1.Range("E6" & ":I" & f1.Range("E" & Rows.Count).End(xlUp).Row)
  For i = 1 To UBound(t1)
        clé = t1(i, 1) & "|" & t1(i, 5)
        If d.exists(clé) Then
           PositionTable_t = d(clé)
        Else
           ' clé non trouvée
        End If
  Next i
  MsgBox "durée du traitement: " & Format(Timer - start, "0.000") & " secondes"
End Sub

Boisgontier

 

[laurent950]

Bonsoir Calvus, Dranreb, Boisgontier, Le forum

La structure “Dictionnaire” dans VBA
j'ai trouvé cette explication inintéressante suite à ce poste :

La structure "Dictionnaire" dans VBA (tutoriel) | Excel-Malin.com

Tutoriel pour apprendre à utiliser la structure Dictionnaire (clé - valeur) dans Excel / VBA. Explications, exemples et codes sources VBA.

excel-malin.com

Pour Mémoire : http://boisgontierjacques.free.fr

Add clé,élément	Ajoute une clé et la valeur associée
Exists(clé)	Teste l'existence d'une clé
Tbl=Items	Donne dans un tableau les éléments
Tbl=Keys	Donne dans un tableau les clés
Remove (clé)	Suprime la clé
Removeall	Supprime tous les éléments
Count	Donne le nombre d'éléments
Item(clé) =valeur	Modifie la valeur de la clé
Item(clé)	Donne la valeur associée à la clé
CompareMode=vbTextCompare	Ignore la casse

Merci Monsieur boisgontier

cdt

Ps : cela aussi dans un autre contexte a exploiter ( fonction pour concaténer des cellules d'un range disjoint ) / ( Find index with multiple condition, using find function )

Fonction pour concaténer des cellules d'un range disjoint

J'ai besoin de lancer en VBA une formule mathématique de la bibliothèque standard ("WorksheetFunction") du type Min, Max ou régression linéaire sur un range...

forum.excel-pratique.com

Find index with multiple condition, using find function

Hi all, stuck again, search for solutions but with no help. I have large csv files(millions rows, 200 columns- text & numbers) that i could open with "datastore" (for now i work only on he firs...

www.mathworks.com

laurent

 

[Calvus]

Bonsoir,

@BOISGONTIER
Merci, ça va super vite !!
Pourquoi le
clé = t(i, 1) & "|" & t(i, 5) ?
On ne peut pas le faire autrement ? Affecter 2 valeurs à une clé ?
J'essaie de comprendre le tout et refaire tout seul.
Merci en tout cas.

@laurent950
Merci de tes précsions.
Je ne connaissais pas le 3ème lien.

Bonne soirée.

 

[laurent950]

Bonsoir Calvus;
Clavus, je pense que Mondico "Microsoft script ing run Time" C'est une sorte de module de classe qui a été programmée pour des programmeur. Comment dire !
je me suis aussi posé cette question "être dépendant des classes d'Excel et des nombreuses mises à jour sans aucune maîtrise de ce qui se passe en arrière-plan ! alors j'ai pensé à faire un module de classe. D'où votre question ?J'ai fait quelques choses (mais avec plaisir si vous avez aussi des solutions)
On ne peut pas le faire autrement . Affecter 2 valeurs à une clé .J'essaie de comprendre le tout et refaire tout seul.Merci en tout cas.
Boisgontier a réduit : le temps est de 0,008 sec au lieu de 0,02 sec pour le tableau.
donc
- les 0,008 avec Mondico "Microsoft script ing run Time"
- Et Moi avec 0,00781250000 seconde !
avec mon module de classe (selon votre exemple) du Poste #1

Je poste ma solution :

Module Standard : Test
Ps : Pour avoir la vitesse du programme il faut neutralisé cette ligne (En commentaire) mettre la coche devant la ligne
'MsgBox "Prospect existant ! " & Chr(10) & Chr(10) & MonDico.CibleTrouver

Option Explicit

' https://www.commentcamarche.net/faq/41001-vba-verifier-si-variable-stockee-dans-une-variable-tableau
Sub TestTer_Prospects_Existants()

Dim start As Single
start = Timer

Dim f As Worksheet
    Set f = Worksheets("Prospects Attente")
Dim Feuil1 As Worksheet
    Set Feuil1 = Worksheets("Général")

'création de l'Objet Dictionnaire
' substitution de mon dico par la classe MonDico
Dim MonDico As MonDico
    Set MonDico = New MonDico

' Envois dans le module de classe le tableau
    MonDico.TabBdOrigine = f.Range("E3:I" & f.Range("E" & Rows.Count).End(xlUp).Row)

    MonDico.TabBdCompare = Feuil1.Range("E6:I" & Feuil1.Range("E" & Rows.Count).End(xlUp).Row)

' Traite le resultat
    MonDico.Dico

' Pour avoir la vitesse du programme (Mettre cette ligne ci dessous en commentaire)
MsgBox "Prospect existant ! " & Chr(10) & Chr(10) & MonDico.CibleTrouver

' detruit la classe
Set MonDico = Nothing

'MsgBox "durée du traitement: " & Timer - start & " secondes"
MsgBox "durée du traitement: " & Format(Timer - start, "0.000000000000") & " secondes"

End Sub

Module de Classe : MonDico

Option Base 1
Dim m_TabTempOrigine As Variant
Dim m_TabTempCompare As Variant
Dim m_Resultat As String
Property Let TabBdOrigine(BaseTempOrigine As Variant)
    m_TabTempOrigine = BaseTempOrigine
End Property
Property Let TabBdCompare(BaseTempCompare As Variant)
    m_TabTempCompare = BaseTempCompare
End Property
Property Get CibleTrouver() As String
    CibleTrouver = m_Resultat
End Property
Sub Dico()
Dim i As Double

' Stock Origine
    ReDim Preserve m_TabTempOrigine(LBound(m_TabTempOrigine, 1) To UBound(m_TabTempOrigine, 1), LBound(m_TabTempOrigine, 2) To UBound(m_TabTempOrigine, 2) + 1)
    For i = LBound(m_TabTempOrigine, 1) To UBound(m_TabTempOrigine, 1)
        m_TabTempOrigine(i, UBound(m_TabTempOrigine, 2)) = m_TabTempOrigine(i, 1) & m_TabTempOrigine(i, 5)
    Next i
i = Empty

' Stock Compare
    ReDim Preserve m_TabTempCompare(LBound(m_TabTempCompare, 1) To UBound(m_TabTempCompare, 1), LBound(m_TabTempCompare, 2) To UBound(m_TabTempCompare, 2) + 1)
    For i = LBound(m_TabTempCompare, 1) To UBound(m_TabTempCompare, 1)
        m_TabTempCompare(i, UBound(m_TabTempCompare, 2)) = m_TabTempCompare(i, 1) & m_TabTempCompare(i, 5)
    Next i
i = Empty

' Pour une recherche dans dans la première colonne d'un tableau 2D:
Dim mot As String
    For i = LBound(m_TabTempOrigine, 1) To UBound(m_TabTempOrigine, 1)
    ' Fonction
        mot = m_TabTempOrigine(i, UBound(m_TabTempOrigine, 2))
        EstDans mot, m_TabTempCompare
            If m_Resultat <> Empty Then
                Exit Sub
            End If
        mot = Empty
    Next i
i = Empty
End Sub

Function EstDans(mot As String, Tabl As Variant) As Boolean
Dim Dimension As Byte, j As Integer

On Error Resume Next
If IsError(UBound(Tabl, 2)) Then Dimension = 1 Else Dimension = 2
On Error GoTo 0

Select Case Dimension
    Case 1
        On Error Resume Next
        EstDans = Application.Match(mot, Tabl, 0)
        On Error GoTo 0
    Case 2
        For j = UBound(Tabl, 2) To UBound(Tabl, 2) '1 To UBound(Tabl, 2)
            On Error Resume Next
            EstDans = Application.Match(mot, Application.Index(Tabl, , j), 0)
            On Error GoTo 0
            If EstDans = True Then
                m_Resultat = mot & " " & "Feuille Générale - N° Ligne E" & Application.Match(mot, Application.Index(Tabl, , j), 0) + 5
                Exit For
            End If
        Next
End Select
End Function
Private Sub Class_Terminate()
' decharge les variable
    Erase m_TabTempOrigine
    Erase m_TabTempCompare
    m_Resultat = Empty
End Sub

Vous aimez ma thérory Clavus ?

Aussi Clavus j'ai écrit cela en dur :
- m_Resultat = mot & " " & "Feuille Générale - N° Ligne E" & Application.Match(mot, Application.Index(Tabl, , j), 0) + 5

Correspondance de 111 = case 111 du tableau / Application.Match(mot, Application.Index(Tabl, , j), 0)
C'est a dire que l'ont peux tous stoker et retrouver puisque l'ont connais la ligne du tableau soit 111
donc case 111 (Ligne du tableau) qui correspond a la feuille générale soit E116 Feuille générale / donc (111+5) pour le N° de ligne de la feuille


Ps : Dranred est Hyper fort et technique bien plus fort que moi, si il a aussi un avis sur le sujet, je serais vrais content d'apprendre encore et me perfectionner?

Peut être que BoisGontier aura aussi des idées sur le sujet !

Pour vous tous : ce lien pour faire une recherche dans une variable tableau en isntatanné que j'ai associer a mon module de classe
je joint le lien ci-dessous :
https://www.commentcamarche.net/faq/41001-vba-verifier-si-variable-stockee-dans-une-variable-tableau

Cdt


Laurent

 

[Calvus]

Bonsoir,

Merci beaucoup Laurent950.
Je vais regarder ça de près et te dirai ce que j'en pense.

A bientôt.