Une recherche Vba plus rapide

[GeoTrouvePas]

Bonjour tout le monde,

Pour compléter des lignes, je dois effectuer une recherche sur un onglet "base" en recherchant la ligne qui comprend le même nom et dont la date est comprise entre "date début" et "date fin".

J'ai réalisé une macro qui paluche bêtement chaque ligne de cette base mais avec 50 000 lignes à compléter, cela prend un temps fou (50% de lignes effectuées en 1h30).

Auriez vous une idée pour effectuer cette recherche plus rapidement ? (J'ai essayé de passer par une variable tableau mais ce n'est guère mieux)

Je vous remercie par avance

 

[vgendron]

sinon. un TCD ??
mais la. c'est sans moi.. :-D je ne connais pas du TOUT !

 

[zebanx]

@gosselien
Merci pour ton retour.
J'ai tenté quand même mais c'est plus long comme tu me l'avais indiqué mais j'avais commencé et ça me fait réviser les formules en VBA de toute manière.
Bon, je ne serai pas tenté de recommencé (ie : en gros 1"20 pour les 1500 lignes et c'est toujours mieux de le tester et de voir comment on intègre éventuellement cela à un "findnext").

@vgendron
Je doute que ça te prenne trop de temps pour savoir maitriser les TCD. Entre 5 et 10 min peut-être


Sinon, pas de nouvelles de GeoTrouvePas ? Les codes ne lui permettent pas d'aller à la vitesse désirée mais entre 50% pour 1h30 et la solution proposée par Vgendron,...

 

[laetitia90]

bonjour tous
ok avec toi Gosselien sans passer par formule ou TCD la solution est tablo est dico... mega rapide

mais sans savoir le nb... item a chercher ????? si pour chercher 10 cells... find ou match suffisant
un exemple avec match pour le fun

Sub es()
    Dim a, i As Long
    Application.ScreenUpdating = 0
   With Feuil1
    For i = 1 To Feuil2.Cells(Rows.Count, 1).End(3).Row
    a = Application.Match(Cells(i, 1), Feuil1.Range("a:a"), 0)
    If Not (IsError(a)) Then
    If Feuil2.Cells(i, 2) >= .Cells(a, 2) And Feuil2.Cells(i, 2) <= .Cells(a, 3) Then _
    Feuil2.Cells(i, 3) = .Cells(a, 4)
    End If:  Next
  End With
End Sub

attention quand meme avec Application.Match si beaucoup de recherche trés lent

 

[zebanx]

Bonsoir Laetitia90

C'est juste hyper rapide ton code.

On partait de 50% du traitement sur 1h30 #1 (60000 lignes BDD et liste de demandes)
On a deux solutions dont la plus rapide pour ~ 30 secondes (50000 lignes BDD et liste de 1500 demandes)
Et là, sur un test, ça se fait en moins de 10 secondes (50 000 lignes BDD et liste de 5000 demandes)

Et en plus en une dizaine de lignes.

Eh bien un grand merci !

GeoTrouvePas : tu as le code rêvé pour réaliser ta demande là!

 

[mapomme]

Bonjour à tous,

Un essai via tableaux et dictionary comme l'a suggéré laetitia90 que je salue . Il faut d'abord initialiser la feuille "Base" puis la feuille "A compléter".

 

[zebanx]

Hello Mapomme

Merci pour ta proposition.

On a un post de "suite" (poker) :
- dictionnaire (scripting D.)
- application match
- tablo
- findnext

Ces 4 codes peuvent être conservées dans un fichier et cela m'a permis d'apprécier, sur une BDD longue, des différences assez étonnantes de durée pour ce qui serait une formule de SOMMEPROD à 3 critères (nom + date > + date <).
Moins étonné pour le SD mais pour les trois autres, les différences restent significatives.

Mais j'ai vraiment apprécié ce post pour les méthodes et la rédaction des lignes de codes proposées (épurées et claires). Ce n'est pas mon post initialement* mais je vous remercie pour ces nombreuses contribution.

bonne journée
zebanx

?? Où est GeoTrouvePas

 

[klin89]

Bonsoir à tous,

ou ceci :

Option Explicit
Sub test()
Dim a, b, i As Long, dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    a = Sheets("A compléter").Range("a1").CurrentRegion.Resize(, 3).Value2
    For i = 1 To UBound(a, 1)
        dico(a(i, 1)) = VBA.Array(i, a(i, 2))
    Next
    b = Sheets("Base").Range("a1").CurrentRegion.Value2
    For i = 2 To UBound(b, 1)
        If dico.exists(b(i, 1)) Then
            If dico(b(i, 1))(1) >= b(i, 2) And dico(b(i, 1))(1) <= b(i, 3) Then
                a(dico(b(i, 1))(0), 3) = b(i, 4)
            End If
        End If
    Next
    Sheets("A compléter").Range("a1").Resize(UBound(a, 1), UBound(a, 2)) = a
    Set dico = Nothing
End Sub

klin89

 

[gosselien]

Bonjour à tous ;-

C'est bien le code de @mapomme qui est le gagnant à mon humble avis

Il faudrait à présent l'avis du demandeur

P.

 

[mapomme]

Bonsoir à tous,

Pour continuer la course à l'échalote, deux méthodes (laetitia90 modifiée + une nouvelle mapommeV2) ainsi que mapommeV1 qui sert de référence.

La différence est qu'on s'autorise (si, si !) cette fois à trier la base et la feuille de recherche.

Dans ce cas, le méthode de laeticia90 devient très rapide (méthode :
laetitia90avecTRI). Dans application.match, on a juste remplacé le paramètre de valeur 0 par la valeur 1.

Le tri des deux feuilles m'a permis de développer une autre manière de faire - sans dictionnaire - qui , me semble-t-il, est encore plus véloce (méthode : mapommeV2).

edit : intégration en dernière minute de la macro de klin89 .
Attention : la méthode de klin89, en cas de doublons de noms sur la feuille 'A compléter', ne retourne un résultat que pour le dernier doublon du groupe de même nom.

 

[zebanx]

Bonjour à tous,

@mapomme

Merci pour ce nouveau petit bijou et la contribution à ce post.
Pourriez-vous s'il vous plait m'apporter quelques précisions sur des lignes que j'ai du mal à comprendre dans leur rédaction sur le code SD ?

Le code "tablo", le dernier proposé, me parait plus simple d'approche mais le code SD reste utile et ayant toujours de grosses difficultés à comprendre comment cela fonctionne (par exemple sur le matching entre dico(tablo(i,1) de la baseMP et tablo (i,1) de la deuxième feuille) puisque le pas à pas détaillé ne permet de rien voir, je me permets de vous solliciter sur votre expertise dans le domaine.
J'ai essayé de résumer en 3ième page pour synthétiser ma compréhension, ce serait peut-être plus rapide pour vous de modifier directement sur cette page.

Je vous en remercie par avance pour ces explications sur le code SD, bonne journée,
zebanx

 

[gosselien]

re à tous ;
super code de mapomme encore une fois
Attention que la vitesse chez l'un et chez l'autre est sûrement différente, n'ayant pas les mêmes machines
Le plus rapide chez moi est de 0.03 sec le moins 0.22 sec
P.

 

[mapomme]

Bonjour à tous,

Attention que la vitesse chez l'un et chez l'autre est sûrement différente, n'ayant pas les mêmes machines
Le plus rapide chez moi est de 0.03 sec le moins 0.22 sec

C'est certain. Avec mon vieux micro, le plus rapide est 0,13 sec ! Il est vieux (plus de dix ans) mais je l'aime toujours . Peut-être pour plus très longtemps vu le bruit de crécelle que fait le ventilo de la carte vidéo depuis une dizaine de jour.

Pourriez-vous s'il vous plait m'apporter quelques précisions sur des lignes que j'ai du mal à comprendre dans leur rédaction sur le code SD ?

Voir dans le fichier joint, quelques explications. N'hésitez pas à me relancer si ce n'est pas clair pour vous.

 

[zebanx]

Un grand merci MaPomme pour le temps consacré et les explications pour chaque passage.
C'est plus clair et cela constitue une base solide à conserver et à reprendre pour s'entrainer.
Vraiment sympa.

Je vous souhaite, comme à tous les utilisateurs d'E.D., une bonne soirée et un bon we.
zebanx.

 

[laetitia90]

bonsoir tous
salut Mapomme
je viens de decouvrir ton dernier fichier que dire...... super ton dernier code sans dico

j'ai fais quelques test autant profiter de ton boulot

base 1 million de lignes recherche 100000 lignes
ton dernier code 0.81 seconde ... assez fabuleux
methode match trie 2.58 seconde


ps :code a l'ami klin89 13.4 secondes j'ai modifier un peu pour la restitution pb...
Application.Index(a, 0, 3) idem application transpose <65536

bravo encore mapomme
leti a+

 

[vgendron]

Hello @tous
juste "Wouah !"
et merci !! :-D