Importer les données d'une plage en fonction des en-tete de colonne avec RechercheV

[dlambert]

Bonjour,

J'aimerais faire une importation des données d'une plage d'une autre feuille en fonctions des critères suivants avec la fonction "RechercheV":
- Critères des lignes > 0 ou <> ""
- Titre en-tête de colonne.

Pour ce fait je me suis servi d'une macro élaborée à partir de plusieurs macros trouvées sur ce forum:

!!! Pouvez vous m'aider à améliorer ce code?

Sub AppelSub()

Feuil1.Range("B3:X20000").ClearContents

  Set Table = Feuil2.Range("A2:AO20000")      ' champ table source
  Set Clés = Feuil1.Range("A3:A68000")      ' champ des clés recherchées
  Set Résultat = Feuil1.Range("B3:B68000")  ' champ résultat
  colResult = Range("B1")
  Rechv Clés, Table, colResult, Résultat
  

  Set Table = Feuil2.Range("A2:AO20000")      ' champ table source
  Set Clés = Feuil1.Range("A3:A68000")      ' champ des clés recherchées
  Set Résultat = Feuil1.Range("C3:C68000")  ' champ résultat
  colResult = Range("C1")
  Rechv Clés, Table, colResult, Résultat


  Set Table = Feuil2.Range("A2:AO20000")      ' champ table source
  Set Clés = Feuil1.Range("A3:A68000")      ' champ des clés recherchées
  Set Résultat = Feuil1.Range("D3:D68000")  ' champ résultat
  colResult = Range("D1")
  Rechv Clés, Table, colResult, Résultat


  Set Table = Feuil2.Range("A2:AO20000")      ' champ table source
  Set Clés = Feuil1.Range("A3:A68000")      ' champ des clés recherchées
  Set Résultat = Feuil1.Range("E3:E68000")  ' champ résultat
  colResult = Range("E1")
  Rechv Clés, Table, colResult, Résultat


  Set Table = Feuil2.Range("A2:AO20000")      ' champ table source
  Set Clés = Feuil1.Range("A3:A68000")      ' champ des clés recherchées
  Set Résultat = Feuil1.Range("F3:F68000")  ' champ résultat
  colResult = Range("F1")
  Rechv Clés, Table, colResult, Résultat


  Set Table = Feuil2.Range("A2:AO20000")      ' champ table source
  Set Clés = Feuil1.Range("A3:A68000")      ' champ des clés recherchées
  Set Résultat = Feuil1.Range("G3:G68000")  ' champ résultat
  colResult = Range("G1")
  Rechv Clés, Table, colResult, Résultat


  Set Table = Feuil2.Range("A2:AO20000")      ' champ table source
  Set Clés = Feuil1.Range("A3:A68000")      ' champ des clés recherchées
  Set Résultat = Feuil1.Range("H3:H68000")  ' champ résultat
  colResult = Range("H1")
  Rechv Clés, Table, colResult, Résultat


  Set Table = Feuil2.Range("A2:AO20000")      ' champ table source
  Set Clés = Feuil1.Range("A3:A68000")      ' champ des clés recherchées
  Set Résultat = Feuil1.Range("I3:I68000")  ' champ résultat
  colResult = Range("I1")
  Rechv Clés, Table, colResult, Résultat


  Set Table = Feuil2.Range("A2:AO20000")      ' champ table source
  Set Clés = Feuil1.Range("A3:A68000")      ' champ des clés recherchées
  Set Résultat = Feuil1.Range("J3:J68000")  ' champ résultat
  colResult = Range("J1")
  Rechv Clés, Table, colResult, Résultat
  
  Set Table = Feuil2.Range("A2:AO20000")      ' champ table source
  Set Clés = Feuil1.Range("A3:A68000")      ' champ des clés recherchées
  Set Résultat = Feuil1.Range("K3:K68000")  ' champ résultat
  colResult = Range("K1")
  Rechv Clés, Table, colResult, Résultat
  
  Set Table = Feuil2.Range("A2:AO20000")      ' champ table source
  Set Clés = Feuil1.Range("A3:A68000")      ' champ des clés recherchées
  Set Résultat = Feuil1.Range("L3:L68000")  ' champ résultat
  colResult = Range("L1")
  Rechv Clés, Table, colResult, Résultat
  
  Set Table = Feuil2.Range("A2:AO20000")      ' champ table source
  Set Clés = Feuil1.Range("A3:A68000")      ' champ des clés recherchées
  Set Résultat = Feuil1.Range("M3:M68000")  ' champ résultat
  colResult = Range("M1")
  Rechv Clés, Table, colResult, Résultat
  
  Set Table = Feuil2.Range("A2:AO20000")      ' champ table source
  Set Clés = Feuil1.Range("A3:A68000")      ' champ des clés recherchées
  Set Résultat = Feuil1.Range("N3:N68000")  ' champ résultat
  colResult = Range("N1")
  Rechv Clés, Table, colResult, Résultat
  
  Set Table = Feuil2.Range("A2:AO20000")      ' champ table source
  Set Clés = Feuil1.Range("A3:A68000")      ' champ des clés recherchées
  Set Résultat = Feuil1.Range("O3:O68000")  ' champ résultat
  colResult = Range("O1")
  Rechv Clés, Table, colResult, Résultat
  
  Set Table = Feuil2.Range("A2:AO20000")      ' champ table source
  Set Clés = Feuil1.Range("A3:A68000")      ' champ des clés recherchées
  Set Résultat = Feuil1.Range("P3:P68000")  ' champ résultat
  colResult = Range("P1")
  Rechv Clés, Table, colResult, Résultat
  
  Set Table = Feuil2.Range("A2:AO20000")      ' champ table source
  Set Clés = Feuil1.Range("A3:A68000")      ' champ des clés recherchées
  Set Résultat = Feuil1.Range("R3:R68000")  ' champ résultat
  colResult = Range("R1")
  Rechv Clés, Table, colResult, Résultat
  
  Set Table = Feuil2.Range("A2:AO20000")      ' champ table source
  Set Clés = Feuil1.Range("A3:A68000")      ' champ des clés recherchées
  Set Résultat = Feuil1.Range("T3:T68000")  ' champ résultat
  colResult = Range("T1")
  Rechv Clés, Table, colResult, Résultat
  
  Set Table = Feuil2.Range("A2:AO20000")      ' champ table source
  Set Clés = Feuil1.Range("A3:A68000")      ' champ des clés recherchées
  Set Résultat = Feuil1.Range("V3:V68000")  ' champ résultat
  colResult = Range("V1")
  Rechv Clés, Table, colResult, Résultat
  
  Set Table = Feuil2.Range("A2:AO20000")      ' champ table source
  Set Clés = Feuil1.Range("A3:A68000")      ' champ des clés recherchées
  Set Résultat = Feuil1.Range("W3:W68000")  ' champ résultat
  colResult = Range("W1")
  Rechv Clés, Table, colResult, Résultat
  
  Set Table = Feuil2.Range("A2:AO20000")      ' champ table source
  Set Clés = Feuil1.Range("A3:A68000")      ' champ des clés recherchées
  Set Résultat = Feuil1.Range("X3:X68000")  ' champ résultat
  colResult = Range("X1")
  Rechv Clés, Table, colResult, 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) = ""
  Next i
  Résultat.Value = temp
  Messagebox = "Terminé"
End Sub

 

[tototiti2008]

Re : Importer les données d'une plage en fonction des en-tete de colonne avec Recherc

Bonjour dlambert,

Tu es dans la section Trucs et astuces
Si tu veux poster une question, va dans Forum Excel https://www.excel-downloads.com/forums/forum-excel.7/
Bouton Ouvrir une nouvelle discussion
Pour t'aider à optimiser du code, il faudrait qu'on puisse voir à quelles données il s'applique

 

[Dranreb]

Re : Importer les données d'une plage en fonction des en-tete de colonne avec Recherc

Bonjour.

Difficile de bien cerner ce que vous avez voulu faire.
On verrait mieux sur un classeur joint, avec 10 lignes bidons en Feuil1, 5 en Feuil2, et 3 ou 4 colonnes de titres de la feuille indéfinie.
Et 2 lignes de résultats souhaités sur la feuille concernée (en rouge peut être)

P.S Mais à priori il n'y a pas nécessité de charger une vingtaine de fois Feuil2.Range("A2:AO20000") ni Feuil1.Range("A3:A68000") .
Ni même peut être de constituer à chaque fois un Dictionary, à condition de ranger dans un seul les numéros de lignes au lieu des valeurs trouvées à leurs colonnes considérées. Mais on s'y perd un peu en essayant de le réaliser car on ne vois pas ce qu'on fait. En aveugle ce n'est pas simple.

 

[dlambert]

Re : Importer les données d'une plage en fonction des en-tete de colonne avec Recherc

Bonjour,

Voici la modification apportée avec fichiers en exemple...

https://www.excel-downloads.com/thr...-en-tete-de-colonne-avec-recherchev.20000137/

Merci

 

[Dranreb]

Re : Importer les données d'une plage en fonction des en-tete de colonne avec Recherc

Bonjour.

Joignez votre petit fichier de test ici. (Aller en mode avancé, Gérer les pièces jointes)