VBA : Accélérer RechercheV classique entre 2 onglets

[AlexandreP]

Bonsoir à tous,

Mes très légères notions en VBA ne me permettent pas de trouver une solution à mon problème qui je suis sûr est très facile à résoudre ! (ça va faire plusieures heures que je cherche en vain sur des tutoriels et forum... )

Mon fichier ci-joint contient 2 onglets (1 "Data" et 1 onglet "REmplir_Coordonnées").

Je souhaiterai remplacer mes rechercheV de l'onglet "Remplir" qui m'affiche diverses informations dans les colonnes G, H, I, J ... en fonction du code client, afin de gagner un temps énorme lorsque j'actualise mon fichier

En effet mon fichier original contient plus de 500 000 lignes (15 000 codes clients uniques se répétant) et une dizaine de colonnes, soit plus de 10 * 500 000 = 5 Millions de RecherchesV. le temps de mise à jour des formules est donc de plusieurs dizaines de minutes chaque semaine....

Dans l'idée, après avoir triés tous mes codes clients (Pour que les codes identiques soient les uns en dessous des autres), j'aimerai :
- Trouver la ligne correspondant à mon code client dans le fichier Data.
- Copier l'ensemble des coordonnées de ce clients (colonnes E à H de "Data")
- Les coller directement dans "Remplir_Coordonées" en face de toutes mes récurrences

-Tout cela dans une boucle qui passerait en revue ces 15 000 codes 1 par 1.

Est-ce possible ?

Merci de votre aide,

Alexandre

 

[BOISGONTIER]

Re : VBA : Accélérer RechercheV classique entre 2 onglets

Bonsoir,

-Si la table de l'onglet DATA est TRIEE par code, utiliser la valeur VRAI dans le 4e paramètre de Recherchev()
-Si la table n'est pas triée:

Cf Fonction perso plus rapide que Recherchev()

-sélectionner G2:G261
=rechvM($C$2:$C$261;Table;2;"inconnu")
Valider avec maj+ctrl+entrée

Function RechvM(clé As Range, champ As Range, colResult, messageErreur)
  Application.Volatile
  Set d = CreateObject("Scripting.Dictionary")
  a = champ.Value
  b = clé.Value
  For i = LBound(a) To UBound(a)
    d(a(i, 1)) = a(i, colResult)
  Next i
  Dim temp()
  ReDim temp(LBound(b) To UBound(b))
  For i = LBound(b) To UBound(b)
    If d(b(i, 1)) <> "" Then temp(i) = d(b(i, 1)) Else temp(i) = messageErreur
  Next i
  RechvM = Application.Transpose(temp)
End Function

https://www.excel-downloads.com/thr...rchev-pour-tableaux-taille-importante.203411/

JB

 

[AlexandreP]

Re : VBA : Accélérer RechercheV classique entre 2 onglets

Merci beaucoup pour votre réponse rapide et très précise.

Cette fonction a l'air bluffante !

Cependant comment faite vous pour créer le champs "Table", qui apparait tel quel dans la fonction et non sous la forme Data!$D$3:$H$10000 dans la rechercheV ou matricielle ? [ =rechvM($C$2:$C$261;Table;2;"inconnu") et =RECHERCHEV($C5;Table;2;VRAI) ]

 

[BOISGONTIER]

Re : VBA : Accélérer RechercheV classique entre 2 onglets

Formules/Gestionnaire de noms ou Insertion/nom/Définir en version <2007

JB

 

[AlexandreP]

Re : VBA : Accélérer RechercheV classique entre 2 onglets

Bonjour JB,

J'ai une dernière question au sujet de la REchvM : est-il possible de modifier le code pour pouvoir effectuer la recherche dans un range de plus de 65000 cellules ? (ie : rechvM($C$2:$C$500 000;Table;2;"inconnu")

 

[BOISGONTIER]

Re : VBA : Accélérer RechercheV classique entre 2 onglets

Bonjour,

Dans l'exemple ci joint, la table a 80.000 lignes

JB

 

[AlexandreP]

Re : VBA : Accélérer RechercheV classique entre 2 onglets

Merci,

Cependant, quand je modifie "la taille" de la clé, dès que je dépasse 65000 ligne, la formule m'affiche #Valeur !.

 

[BOISGONTIER]

Re : VBA : Accélérer RechercheV classique entre 2 onglets

Bonsoir,

Une fonction ne peut pas retourner plus de 65.000 Lignes.
Voir une autre solution en PJ.

Sub AppelSub()
  Set Table = Range("A2:B1200")      ' champ table source
  Set Clés = Range("I2:I68000")      ' champ des clés recherchées
  Set Résultat = Range("J2:J68000")  ' champ résultat
  colResult = 2
  Rechv Clés, Table, 2, Résultat
End Sub

Sub Rechv(Clés, Table, colRésult, Résultat)
  Application.ScreenUpdating = False
  Set d = CreateObject("Scripting.Dictionary")
  a = Table.Value       ' table source
  b = Clés.Value        ' table des clés recherchées
  For i = LBound(a) To UBound(a)
    d(a(i, 1)) = a(i, colRésult)
  Next i
  Dim temp()
  ReDim temp(LBound(b) To UBound(b), 1 To 1)
  For i = LBound(b) To UBound(b)
    If d(b(i, 1)) <> "" Then temp(i, 1) = d(b(i, 1)) Else temp(i, 1) = "Inconnu"
  Next i
  Résultat.Value = temp
End Sub

Pour récupérer plusieurs colonnes contigues

Sub AppelSub()
  Set Table = [BD]      ' champ table source
  Set Clés = Range("C2:C201")      ' champ des clés recherchées
  Set Résultat = Range("G2:J201")  ' champ résultat
  colResult = 2
  ncolResult = 4
  RechvMultCol Clés, Table, Résultat, ncolResult
End Sub

Sub RechvMultCol(Clés, Table, Résultat, ncolResult)
  Application.ScreenUpdating = False
  Set d = CreateObject("Scripting.Dictionary")
  a = Table.Value       ' table source
  b = Clés.Value        ' table des clés recherchées
  For i = LBound(a) To UBound(a)
    t = CStr(a(i, 1))
    d(t) = a(i, 2)
    For k = 3 To ncolResult + 1
      d(t) = d(t) & " : " & a(i, k)
    Next k
  Next i
  Dim temp()
  ReDim temp(LBound(b) To UBound(b), 1 To UBound(a, 2))
  For i = LBound(b) To UBound(b)
      t = CStr(b(i, 1))
      tmp = d(t)
      tbl = Split(tmp, ":")
      For k = LBound(tbl) To UBound(tbl)
        temp(i, k + 1) = tbl(k)
      Next k
  Next i
  Résultat.Value = temp
End Sub

http://boisgontierjacques.free.fr/fichiers/Cellules/RechvMutColFonction.xls
http://boisgontierjacques.free.fr/fichiers/Cellules/RechvPlus65000Lignes.xlsm
http://boisgontierjacques.free.fr/fichiers/Cellules/RechvMultColPlus65000Lignes.xlsm


Jacques Boisgontier

 

[laetitia90]

Re : VBA : Accélérer RechercheV classique entre 2 onglets

bonjour AlexandreP ,JB
une autre facon de l'ecrire

je split pas le tablo t1 donc il faut lancer la macro de la feuil1 Remplir.... mais bon sur 500000 lignes au moins 30 secondes on peut gagner un peu de temps en utilisant directement Dictionary mais neccesite activer reference
Microsoft Scripting Runtime dans references
pas trop de temps de regarder tout cela .... la solution de l'ami JB bien plus simple & plus rapide a mon avis