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]

Hello

avec des tablo VBA (array) peut etre?

Sub test()
Dim tablo As Variant
Dim recherche As Variant

fintablo = Range("A" & Rows.Count).End(xlUp).Row
tablo = Range("A2:D" & fintablo).Value

finrecherche = Sheets("A compléter").Range("A" & Rows.Count).End(xlUp).Row
recherche = Sheets("A compléter").Range("A1:C" & finrecherche).Value


For i = LBound(tablo, 1) To UBound(tablo, 1)
    For j = LBound(recherche, 1) To UBound(recherche, 1)
        If tablo(i, 1) = recherche(j, 1) And recherche(j, 2) >= tablo(i, 2) And recherche(j, 2) <= tablo(i, 3) Then
            recherche(j, 3) = recherche(j, 3) + tablo(i, 4)
        End If
    Next j
Next i
Sheets("A compléter").Range("A1:C4").Value = recherche

End Sub

ps: Efface la colonne C de ta feuille "A compléter" avant de lancer la macro

 

[vgendron]

avec la partie qui efface automatiquement en début de code
et quelques explications

Sub test()
Dim tablo As Variant 'on déclare les tableaux
Dim recherche As Variant

fintablo = Range("A" & Rows.Count).End(xlUp).Row 'dernière ligne de ta feuille Base (qui doit etre active)
tablo = Range("A2:D" & fintablo).Value 'on récupère TOUTES les VALEURS

finrecherche = Sheets("A compléter").Range("A" & Rows.Count).End(xlUp).Row 'dernière ligne de la feuille a completer
Sheets("A compléter").Range("C1:C" & finrecherche).ClearContents 'on efface la colonne C
recherche = Sheets("A compléter").Range("A1:C" & finrecherche).Value  'on récupère les valeurs


For i = LBound(tablo, 1) To UBound(tablo, 1) 'pour chaque NOM de la feuille base
    For j = LBound(recherche, 1) To UBound(recherche, 1) 'pour chaque nom de la feuille a completer
        If tablo(i, 1) = recherche(j, 1) And recherche(j, 2) >= tablo(i, 2) And recherche(j, 2) <= tablo(i, 3) Then 'test
            recherche(j, 3) = recherche(j, 3) + tablo(i, 4) 'on ajoute le montant
        End If
    Next j
Next i
Sheets("A compléter").Range("A1:C" & finrecherche).Value = recherche 'on colle les valeurs de "recherche" dans la feuille à compléter

End Sub

 

[zebanx]

Bonjour Vgendron, bonjour Geotrouvepas

Le sujet est intéressant (tableau avec limite de date > et date <).

Cependant, je n'arrive pas à faire fonctionner le code du #3 (ie : où apparait la sheet "Base" svp ???)

J'ai tenté de rédiger un code (cf.fichier joint) sur méthode "find" mais qui traite 5000 lignes en 5 min (sur longueur sh"BDD" et sh"A compléter" de 50 000 lignes chacune). C'est bien trop long.
Sur des bases plus réduites, c'est acceptable mais dès qu'on passe une BDD longue, ça reste long (même en essayant de le faire sur la même sheets pour limiter les SELECT).
Et sommeprod effectivement très long.


Cdlt
zebanx

 

[vgendron]

Hello Zebanx

la feuille Base est dans le fichier :-D
ci dessous un code légèrement modifié pour éviter d'avoir la feuille Base active au moment de lancer le code
et je viens de faire le test avec une feuille Base avec 68635 lignes... ca a visiblement pris moins de 1s !!

Sub test()
Dim tablo As Variant
Dim recherche As Variant

With Sheets("Base")
    fintablo = .Range("A" & .Rows.Count).End(xlUp).Row
    tablo = .Range("A2:D" & fintablo).Value
End With

With Sheets("A compléter")
    finrecherche = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("C1:C" & finrecherche).ClearContents
    recherche = .Range("A1:C" & finrecherche).Value
End With

For i = LBound(tablo, 1) To UBound(tablo, 1)
    For j = LBound(recherche, 1) To UBound(recherche, 1)
        If tablo(i, 1) = recherche(j, 1) And recherche(j, 2) >= tablo(i, 2) And recherche(j, 2) <= tablo(i, 3) Then
            recherche(j, 3) = recherche(j, 3) + tablo(i, 4)
        End If
    Next j
Next i
Sheets("A compléter").Range("A1:C" & finrecherche).Value = recherche

End Sub

 

[zebanx]

Bonjour Vgendron

Ca fonctionne mais sur un temps beaucoup plus long . J'ai juste inséré dans un module en repartant de mon fichier (50000 lignes environ).
Mais n'étant ni l'émetteur du sujet et n'ayant pas de volonté de te faire perdre plus de temps que nécessaire, pourrais-tu stp communiquer ton fichier de test des 65000 lignes ?

Je t'en remercie par avance et bravo pour ce code.

Bonne journée
zebanx

 

[vgendron]

euh.. pour le fichier, j'ai juste fait un copier coller du fichier de GeoTrouvePas..

 

[gosselien]

Bonjour,

et si des noms de "base" ne sont pas dans "à compléter" ?

P.

 

[vgendron]

Bonjour,

et si des noms de "base" ne sont pas dans "à compléter" ?

P.

Hello Gosselien
euh. au vu des tests que je viens de faire. à priori, ca ne bug pas..
et si un nom à compléter n'apparait pas dans la base.. la colonne C (feuille à compléter) reste vide..
aurais tu vu un autre problème qui m'échappe?

 

[gosselien]

Hello Gosselien
euh. au vu des tests que je viens de faire. à priori, ca ne bug pas..
et si un nom à compléter n'apparait pas dans la base.. la colonne C (feuille à compléter) reste vide..
aurais tu vu un autre problème qui m'échappe?

Hello

le code est excellent , rapide et efficace bien sur mais , notre ami ne précise pas (et il n'y a peut être pas pensé) qu'un nom peut être dans les critères de dates mais absent du "petit" tableau en colonne A, donc il n’apparaîtra pas dans "à compléter" ....
et sur 50.000 lignes ça peut arriver

Donc j'aurais vu un mixe de dictionnaire et de tableau (je suis fan je ne maîtrise toujours pas surtout s'il faut utiliser les 2 °_° )

 

[zebanx]

Bonjour Gosselien, re-bonjour Vgendron.

J'arrive à un traitement d'une trentaine de secondes sur ces deux bases là (50000 lignes sur BDD et 1500 lignes sur à compléter avec les deux codes (TEST (VGENDRON) et mon code truffé de select et de IF qui sont de gros ralentisseurs (FINDNEXT)....).
et je ne comprends pas pourquoi je "mouline" avec le code de Vgendron.

zebanx

 

[gosselien]

re à vous 2

idem chez moi , ça rame avec le tableau, je cherche le pourquoi

Find: 45' Tableau: 30'

P.

 

[vgendron]

Hello
effectivement.. ce qui semble augmenter le temps de traitement. c'est le nombre de lignes dans la feuille à completer..
j'ai fais un copier coller dans mon fichier.. je suis quand meme loin des 45 et 90 minutes annoncées par Gosselien.. sauf si c'est une erreur de frappe 45" et 30"
et avec 1500 lignes, ca prend environ 90s
1000 lignes 45s..
voir PJ

 

[zebanx]

Question ouverte:

S'agissant de la méthode FINDNEXT sur une "BDD longue", avez-vous déjà SVP utilisé un code pour délimiter la plage ?

Dans le cas présent, en imaginant des noms de personnes sur 65000 lignes.

Plutôt que : With SHB.Range("a2:a" & derligneB) qui boucle à chaque fois sur 65000 lignes, on essaierait de limiter la plage en utilisant sur les 3 premiers caractères de la cellule pour trouver la ligne de départ et la ligne de fin.

Pour être plus clair, avec une BDD triée en colonne "A", la recherche du mot PIERRE s'effectuerait sur un range "Ax:Ay" avec "x" correspondant à la première équivalence de "PIE" et "y" la dernière équivalence de "PIE" (le terme PIE pouvant être extrait avec un left()).

ou est-ce que cela ne servirait à rien pour vous par rapport au temps de réalisation de la macro ?

Je vous remercie pour vos commentaires par rapport à ce sujet.

cdlt
zebanx

 

[gosselien]

Exact , ce sont des secondes
Sorry
Je ne pense pas que l'on gagne du temps en prenant une partie du mot; ce qui ralenti, c'est le nombre d’occurrences à chercher et j'ai aussi (fatalement) de grosses différences avec 1500 lignes et 100 lignes.

ps: je reste aussi sur mon idée de vérifier que les codes soient tous bien présents dans "à compléter"


P.