XL 2016 fonction rechercheV

[KTM]

Bonsoir Forum
je voudrais utiliser la fonction RechercheV pour extraire des données.
Ma macro fonctionne bien mais avec une lenteur déconcertante vue que mes plages sont très énormes.
Existerait il un moyen de la rendre plus rapide ou autre procedé plus efficace ? MERCI

Sub rechV()
 Dim plage1, plage2, cel As Range
With ActiveSheet
Set plage1 = .Range("AY2:AY" & .Range("AT" & Rows.Count).End(xlUp).Row + 1)
     Set plage2 = .Range("AO1:AP" & .Range("AO" & Rows.Count).End(xlUp).Row + 1)
                     On Error Resume Next
                       For Each cel In plage1
                       cel.Value = 0
                       cel.Value = Application.WorksheetFunction.VLookup(cel.Offset(, -5), plage2, 2, 0)
                       Next cel
                     On Error GoTo 0
End With
End Sub

 

[mapomme]

Bonsoir KTM ,

En passant par des tables en mémoire voire un dictionary. Mais pas de fichier , pas de chocolat

Bonne nuit.

 

[KTM]

Bonsoir KTM ,

En passant par des tables en mémoire voire un dictionary. Mais pas de fichier , pas de chocolat

Bonne nuit.

MERCI mapomme !
Voici un fichier exemple.
Avec peu de données aucun problème mais avec plus de mille lignes il faut patienter plusieurs minutes.

 

[JHA]

Bonjour à tous,

Un essai avec power query pour éviter la formule recherchev() sur des milliers de lignes


JHA

 

[mapomme]

Bonjour @KTM , @JHA ,

Une version VBA. Les codes sont dans le module de la feuille. Deux procédures :

• Init qui initialise des données (100 000 lignes pour le tableau source et 100 000 lignes pour les codes dont on recherche l'âge)
• Degoter pour rechercher les âges

Sur ma bécane, le temps d'exécution de la recherche est d'environ 2,1 s.

Le code de Degoter :

Sub Degoter()
Dim dico As New Dictionary, datader&, data
Dim resultder&, result, i&, clef, deb

   deb = Timer: Application.ScreenUpdating = False
   Set dico = CreateObject("scripting.dictionary")
   dico.CompareMode = 1    'textcompare

   If Me.FilterMode Then Me.ShowAllData
   datader = Cells(Rows.Count, "a").End(xlUp).Row
   data = Cells(1, "a").Resize(datader, 3)

   Range("j2:j" & Rows.Count).ClearContents
   resultder = Cells(Rows.Count, "i").End(xlUp).Row
   result = Cells(1, "i").Resize(resultder, 2)

   For i = 2 To UBound(data): dico(data(i, 1)) = dico(data(i, 1)) & " " & data(i, 3): Next
   For Each clef In dico: dico(clef) = Trim(dico(clef)): Next

   For i = 2 To UBound(result): result(i, 2) = dico(result(i, 1)): Next
   Cells(1, "i").Resize(UBound(result), UBound(result, 2)) = result

   MsgBox Format(Timer - deb, "0.00"), vbInformation
End Sub

nota : je n'ai ni géré les doublons dans la table source, ni géré l'absence du code dans la table source. S'il y a des doublons, alors la recherche renvoie l'ensemble des âges séparés un espace. Si le code à chercher n'est pas dans la table source, on retourne "rien".

 

[KTM]

Bonjour @KTM , @JHA ,

Une version VBA. Les codes sont dans le module de la feuille. Deux procédures :

• Init qui initialise des données (100 000 lignes pour le tableau source et 100 000 lignes pour les codes dont on recherche l'âge)
• Degoter pour rechercher les âges

Sur ma bécane, le temps d'exécution de la recherche est d'environ 2,1 s.

Le code de Degoter :

Sub Degoter()
Dim dico As New Dictionary, datader&, data
Dim resultder&, result, i&, clef, deb

   deb = Timer: Application.ScreenUpdating = False
   Set dico = CreateObject("scripting.dictionary")
   dico.CompareMode = 1    'textcompare

   If Me.FilterMode Then Me.ShowAllData
   datader = Cells(Rows.Count, "a").End(xlUp).Row
   data = Cells(1, "a").Resize(datader, 3)

   Range("j2:j" & Rows.Count).ClearContents
   resultder = Cells(Rows.Count, "i").End(xlUp).Row
   result = Cells(1, "i").Resize(resultder, 2)

   For i = 2 To UBound(data): dico(data(i, 1)) = dico(data(i, 1)) & " " & data(i, 3): Next
   For Each clef In dico: dico(clef) = Trim(dico(clef)): Next

   For i = 2 To UBound(result): result(i, 2) = dico(result(i, 1)): Next
   Cells(1, "i").Resize(UBound(result), UBound(result, 2)) = result

   MsgBox Format(Timer - deb, "0.00"), vbInformation
End Sub

nota : je n'ai ni géré les doublons dans la table source, ni géré l'absence du code dans la table source. S'il y a des doublons, alors la recherche renvoie l'ensemble des âges séparés un espace. Si le code à chercher n'est pas dans la table source, on retourne "rien".

Merci mapomme
C'est spectaculaire
Mais Si le code à chercher n'est pas dans la table source, je voudrais mettre 0. Comment ajuster ?
C'est tres formidable

 

[mapomme]

Re,

Mais Si le code à chercher n'est pas dans la table source, je voudrais mettre 0.

Voir la version v1a

edit: bonjour @Usine à gaz

 

[KTM]

Super ca marche mais un constat :
La macro est dans la feuille.
Pourquoi ne pas mettre la macro dans un module ?
Une préoccupation:
J'ai essayé d'adapter a mon fichier d'origine mais un message d'erreur !