Application.WorksheetFunction.VLookup ?????Résolu

Question

Bonjour,

J'ai plusieurs feuilles dans des classeurs différents qui comportent des listes (fruits, légumes,etc... et en regard des poids qui correspondent à des calibres.

Je veux recupérer le poids total d'une sélection et je souhaite utiliser l'appel à une fonction par Application.WorksheetFunction.VLookup.

Je ne m'en sors pas...!
Pour travailler, je me suis limité à une seule feuille : 3 colonnes et 5 lignes, en cherchant seulement à déterminer si la valeur en colonne B est supérieure à la colonne C selon le choix fait en colonne A ; le résultat VRAI1 ; FAUX 0 étant reporté en cellule A1
  A      B          C
1
2 PoidsTable		
3 Fruit	 PoidsPesé  PoidsMin
4 Pomme	 30	    25
5 Poire	 10	    12

la plageA4:C5 s'appelle "FruitsTable"

Voila mon début de code :
Function PoidsLimiteMin(Fruit As String, Pesé As Double, FruitsTable As Range) As Boolean
    ' Retourne VRAI ou FAUX selon que la valeur est dans la limite attendue
    ' VRAI (TRUE) = Valeur HORS limite
    ' FAUX(FALSE) = Valeur correcte (dans la limite)
    Dim PdMin As Single
    PdMin = Application.WorksheetFunction.VLookup(Fruit, FruitsTable, 1, False)
    PoidsLimiteMin = Pesé < PdMin
End Function
'----------------------------------------
Sub QuelPoids()
Range("A1") = PoidsLimiteMin("Pomme", 25, FruitsTable)
End Sub

Bien sûr dans cet exemple un simple script de formule "RechercheV" fait l'affaire ; de même une macro pourrait à chaque recherche copier une formule (ex cell.FormulaR1C1 =); mais vu le nombre de recherches sur des classeurs différents, cette solution est trop lourde et trop lente.

Merci pour toute aide au débutant que je suis.

Cordialement
Rataxes64

CerberusPau · Accepted Answer

Bonjour,

En fait, 
Range(Cells(2, j + 3)).Value 
n'est pas la bonne syntaxe...


Par ailleurs je ne sais toujours pas pourquoi le script  du "Code1" n'est pas correct: je l'écarte!


Voila le code final qui utilise toujours une variable ("Pds") pour récupérer le résultat de VlookUp, mais  qui ne fait plus appel à une transcription pour retrouver la lettre (merci bigfish!).

Sub TrouverCalibre()
'Affecter un calibre en fonction du poids pesé d'un produit choisi dans la liste

'Dans la feuil(1) :
'Liste produit    = D3:D5
'Plage calibres   = E3:H5
'Nom des Calibres = E2:H2
'Choix liste        en A3 nommé "Choix"
'Poids pesé         en B3 nommé "Pds"
'Calibre trouvé     en C3 nommé "Clb"

    Dim i, j, Pds
    
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect
        
    'Dans la Liste de la ligne 3 à 6 (on pourrait récupérer ces valeurs Row automatiquement)
    For i = 3 To 6
        
        'Dans Plage des valeurs de calibre (on pourrait récupérer ces valeurs Row & Column automatiquement)
        For j = 2 To 5
            
            'Valeur par défaut
            Range("Clb").Value = "Hors Calibre"
            
            'Si résultat VlookUp = Vide: aller au pas de macro suivant
            On Error Resume Next
            
'Code1      Pourquoi ça ne marche pas, sauf pour les 3 premiers calibres du premier choix ?
'°°°°°      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
            'If Range("Pds").Value < Application.WorksheetFunction.VLookup(Range("Choix"), Range("D" & i & ":H" & i), j, False) _
            Then Range("Clb").Value = Range(Lettre & "2").Value _
            : Exit Sub
            
            
'Code 2     En passant par "Pds" et "Cell", ça marche pour tous les choix et tous les calibres.
'°°°°°°     Pds Application.WorksheetFunction.VLookup(Range("Choix"), Range("D" & i & ":H" & i), j, False)
            If Range("Pds").Value < Pds _
            Then Range("Clb").Value = Cells(2, j + 3).Value _
            : Exit Sub

        Next j
    
    Next i

    ActiveSheet.Protect

End Sub

'***************************************************************************

Private Sub Worksheet_Change(ByVal Target As Range)
'Pour tout changement de valeur une des  2 cellules déverrouillées
    
    'Changement du Choix dans la liste
    If Not Intersect(Target, Range("Choix")) Is Nothing Then TrouverCalibre
    
    'Changement du Poids pesé
    If Not Intersect(Target, Range("Pds")) Is Nothing Then TrouverCalibre          'Changement du poids pesé

End Sub


A part cette interrogation qui demeure sur la nécessité de passer par une variable, le code tourne normalement.


Maintenant, il va falloir que je "l'imbrique" avec des boucles For/Next traitées par HlookUp, et j'espère bien pouvoir m'en sortir sans poster!

Merci pour tout

Cordialement
Rataxes64

CGSI3 · Answer

Encore toi ! Rataxes64 (je blague)

On ne perçoit pas trop pourquoi la solution que tu donne ne te convient pas. Explique pourquoi elle est trop lourde.

A mon avis tu devrais penser sous forme d'objets mais plus largement.
A ce titre tu peux faire passer des objets 
dans tes parametres de fonctions.
 
Workbook => Classeur
Worksheets => Feuille
Range => Zone etc
La fonction OFFSET ... Sert toi de F1 sur les mots et de l'aide excel.

Exemple de fonction possible:
Dim A as Range
A=Extraire_Range( ..... )

Function Extraire_Range( NomClasseur As String, NumFeuille as integer, Zone as string) as Range
End Function

Ou alors convertir tes Range en tableau
dim a()
a=Workbooks("Feuil1").Range("A1:E3").value

( Mais ce ne sont que des pistes ...)

Bonne Prog CGSI3

CerberusPau · Answer

Bonjour,

Merci CGS13 de tes conseils, ... et de ton humour.

En fait je voudrais comprendre comment utiliser ".VlookUp" en lieu et place du recours à RECHERCHEV copié par "Formula" dans des cellules pour en récupérer le résultat.

Mon application utilise un grand nombre de tables qui sont appelées en cascade en fonction du résultat d'une recherche antérieure ; le tout dans des feuilles protégées et partagées sous Excel.

J'ai voulu dans mon post illustrer mon besoin de façon simple, avec une seule recherche par ".VlookUp" :

En ligne 2 j'ai en colonne A un produit ("pomme" p.ex), en colonne B son poids pesé (résultat d'une entrée), et en colonne C son poids minimum.
Même chose en ligne 3, mais pour un autre produit ("poire p.ex).

La macro que je voudrais écrire doit scruter la plage "Produits" (A2:C3) et trouver la correspondance du produit sélectionné (dans une TextBox, en dur dans mon exemple) pour renvoyer le poids minimum correspondant (ce que ferait par exemple la formule =REVHERCHEV("Pomme";A2:C3;3;FAUX) dans une cellule A1).

Ensuite ce résultat (que je reporte en cellule A1 dans nom exemple) pourra être comparé au poids pesé (autre TextBox, colonne B dans mon exemple) d'où on tirera  l'information "VRAI si >" ou "FAUX si <".

Le principal avantage de passer par .VlookUp est que l'on n'a pas d'écriture dans la feuille : Dans mon appli j'ai du "Change" partout qui déclenche des recalculs, la seule autre solution serait de créer une feille dédiée au RECHERCHEV, ce qui allongerait le temps de calcul.

Ai-je été plus clair ?

Merci encore
Cordialement
Rataxes64

CGSI3 · Answer

Nickel ! Tres clair.
Je regarde cela ce soir. (tard ..)
Il faut que je fouille dans mes archives ...
Bonne Journée CGSI3

bigfish_le vrai · Answer

Salut,

si c'est bien une méthode VBA que tu cherches la méthode Find devrait faire l'affaire.


Sub Demo()
    Dim Msg
    On Error Resume Next
    'une fois la valeur trouvée via le find, le offset nous décale de 2 colonnes soit sur la 3ieme colonne.
    Msg = Range("FruitsTable").Find("pomme", MatchCase:=False).Offset(0, 2).Value
    If Not Err 0 Then Msg "valeur non trouvée ! "
    On Error GoTo 0 'annule le précédent On Error Resume Next
    MsgBox Msg
End Sub

A+

CGSI3 · Answer

Pas mieux ... 

Voici juste pour info 2 trucs

Récuperer un tableau dans une variable juste en indiquant 1 case quelconque de celui ci

Dim a()
a = ActiveSheet.Range("D3").CurrentRegion.Value

et ce lien

http://dj.joss.free.fr/faq.htm

Bonne prog CGSI3

CerberusPau · Answer

Bonsoir à tous, Merci pour vos aides, mais j'ai un programme que je dois réparer bourré de VLookUp et HLookUp. Je ne sais pas comment joindre un zip sans déposer une source, et les fichiers déposés sur "ci-joint.fr" ne sont pas accessibles très longtemps. Evidemment, sans le tableau, le code n'est pas très parlant... Je le mets quand même, pour commentaires bien venus. Function Col(LC As Variant) As String LetCol = Array( _ "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", _ "AA", "AB", "AC", "AD", "AE", "AF", "AG", "AH", "AI", "AJ", "AK", "AL", "AM", "AN", "AO", "AP", "AQ", "AR", "AS", "AT", "AU", "AV", "AW", "AX", "AY", "AZ", _ "BA", "BB", "BC", "BD", "BE", "BF", "BG", "BH", "BI", "BJ", "BK", "BL", "BM", "BN", "BO", "BP", "BQ", "BR", "BS", "BT", "BU", "BV", "BW", "BX", "BY", "BZ", _ "CA", "CB", "CC", "CD", "CE", "CF", "CG", "CH", "CI", "CJ", "CK", "CL", "CM", "CN", "CO", "CP", "CQ", "CR", "CS", "CT", "CU", "CV", "CW", "CX", "CY", "CZ", _ "DA", "DB", "DC", "DD", "DE", "DF", "DG", "DH", "DI", "DJ", "DK", "DL", "DM", "DN", "DO", "DP", "DQ", "DR", "DS", "DT", "DU", "DV", "DW", "DX", "DY", "DZ") Col = LetCol(LC) End Function '======= Sub Calibre() Dim i, j On Error Resume Next 'On retrouve son calibre en fonction du poids entré If Range("A3").Value >= Application.WorksheetFunction.VLookup(Range("A3"), Sheets(1).Range("D3:J6"), 1, False) Then For i = 3 To 6 For j = 2 To 6 xx = 0 yy = 0 xx = Application.WorksheetFunction.VLookup(Range("A3"), Sheets(1).Range("D" & i & ":J" & i), j, False) yy = Application.WorksheetFunction.VLookup(Range("A3"), Sheets(1).Range("D" & i & ":J" & i), j + 1, False) If (Range("B3").Value >xx Or xx "<") And Range("B3").Value < yy Then Range("C3").Value = Range(Col(j + 2) & "2").Value Exit For End If Next j If (Range("B3").Value >xx Or xx "X") And Range("B3").Value < yy Then Exit For Next i End If End Sub '======= Private Sub Worksheet_Change(ByVal Target As Range) 'Pour tout changement de valeur dans les cellules déverrouillées If Not Intersect(Target, Range("A3")) Is Nothing Then Calibre If Not Intersect(Target, Range("B3")) Is Nothing Then Calibre End Sub Ce qui est asbolument abominable avec cette fonction, c'est qu'on ne peut pas se passer de "On Error Resume Next" !!! C'est une vraie plaie!!! Cordialement Rataxes64

bigfish_le vrai · Answer

Salut,

tu as oublié de nous poser ta question ! enfin je crois... ou alors c'est pas clair...

pourquoi "on error resume next" est un probleme ?  Je suis pour ma part un grand défenseure de la gestion d'erreur et je ne vois pas le problème ici !
Si ce n'est peut être sa position 

A+

CerberusPau · Answer

Eh oui bigfish, tu as raison, c'est pas trop clair, mais àprès 3h du mat en ayant lutté avec ce  de code, j'espère que tu m'en voudras pas trop.

Donc 2 questions : 

1°) Pourquoi "On Error Resume Next" est-il OBLIGATOIRE alors que la valeur à trouver est parfaitement accessible (aucun pb avec RechercheV ou RecchercheH, selon), et puis, l'ai-je bien positionné ?

2°) Pourquoi faut-il passer par une variable ("p" dans mon code) pour récupérer le résultat avant de l'exploiter ?

Voilà. Je remets le code (plus clair et simpifié) avec en commentaires de quoi reconstruire le tableau de l'exemple.

Autrement, VLookUp serait une fonction intéressante s'il n'y avait ce soucis avec un réslutat erroné. 
Mais peut-être que je ne la maîtrise pas correctement ?


Function Col(LC As Variant) As String
'Il y a peut-être plus simple pour récupérer la(les) lettre(s) d'une colonne à partir sa position...

LetCol = Array( _
    "A", "B", "C", "D", "E", "F", "G", "H")     'etc...
Col = LetCol(LC)

End Function

'==========

Sub Calibre()
'Affecter un calibre en fonction du poids pesé d'un produit choisi dans la liste

'Dans la feuil(1) :
'Liste produit    = D3:D5
'Plage calibres   = E3:H5
'Nom des Calibres = E2:H2
'Choix liste        en A3 nommé "Choix"
'Poids pesé         en B3 nommé "Pds"
'Calibre trouvé     en C3 nommé "Clb"

    Dim i, j, p
    
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect
    
    For i = 3 To 6          'Liste de la ligne 3 à 6 (on pourra faire remonter ces valeurs automatiquement)
        For j = 2 To 5      'Plage des valeurs de calibre (idem) selon des colonnes avec fonction LetCol(LC)
            
            On Error Resume Next                    'OBLIGATOIRE ! Pourquoi ?
            
            Range("Clb").Value = "Hors Calibre"     'Valeur par défaut
            
            'En passant par "p", ça marche...
            'p Application.WorksheetFunction.VLookup(Range("Choix"), Sheets(1).Range("D" & i & ":H" & i), j, False)
            If Range("Pds").Value < p _
            Then Range("Clb").Value = Range(Col(j + 2) & "2").Value _
            : Exit Sub
            
            'Pourquoi là ça ne marche pas ???
            '================================
            'If Range("Pds").Value < Application.WorksheetFunction.VLookup(Range("Choix"), Sheets(1).Range("D" & i & ":H" & i), j, False) _
            Then Range("Clb").Value = Range(Col(j + 2) & "2").Value _
            : Exit Sub
            
            Error Clear                             'RAZ de On Error...  Est-ce bien utile ???
        Next j
    Next i
ActiveSheet.Protect

End Sub

'==========

Private Sub Worksheet_Change(ByVal Target As Range)
'Pour tout changement de valeur dans les cellules déverrouillées
    
    If Not Intersect(Target, Range("Choix")) Is Nothing Then Calibre    'Changement de choix
    If Not Intersect(Target, Range("Pds")) Is Nothing Then Calibre      'Changement du poids pesé

End Sub


Cordialement


Rataxes64

bigfish_le vrai · Answer

AAAAAAAAAAAAAAAAAAAAH ! je commence à comprendre

bon si tu n'as pas encore résolut ton problème voici une première étape concernant la fonction :

Function Col(LC As Variant) As String
    Dim ColAdresse As String
    ColAdresse = Columns(LC).Address(False, False)
    Col = Left$(ColAdresse, InStr(1, ColAdresse, ":") - 1)
End Function

par contre cette fonction pourrait être évitée su tu utilisais la propriété "cells" :

Then Range("Clb").Value = Range(Cells(2, j + 2)).Value

A+

bigfish_le vrai · Answer

J'ai oublier une petite correction sur la fonction.

Function Col(Byval LC As Long) As String 'LC dimensionné à long car la propriété columns attend un long
    Dim ColAdresse As String
    ColAdresse = Columns(LC).Address(False, False)
    Col = Left$(ColAdresse, InStr(1, ColAdresse, ":") - 1)
End Function

A+

CerberusPau · Answer

Merci de ton soutien bigfish.

Tu as raison il faut supprimer cette fonction "Col".

J'ai tenté avec ton code "Cells", mais ça plante et je ne sais pas pourquoi.

Pour récupérer la lettre, j'ai fini par trouver quelquechose (de moins élégant), mais si le script "Code2" est OK, j'aimerais comprendre pourquoi les scripts "Code1" et "Code3" ne marchent pas.

Sub TrouverCalibre()
'Affecter un calibre en fonction du poids pesé d'un produit choisi dans la liste

'Dans la feuil(1) :
'Liste produit    = D3:D5
'Plage calibres   = E3:H5
'Nom des Calibres = E2:H2
'Choix liste        en A3 nommé "Choix"
'Poids pesé         en B3 nommé "Pds"
'Calibre trouvé     en C3 nommé "Clb"

    Dim i, j, Pds
    
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect
        
    'Dans la Liste de la ligne 3 à 6 (on pourrait récupérer ces valeurs Row automatiquement)
    For i = 3 To 6
        
        'Dans Plage des valeurs de calibre (on pourrait récupérer ces valeurs Row & Column automatiquement)
        For j = 2 To 5
            
            'Récupérer la lettre de la colonne
            NumCol = Cells(1, j + 3).Column
            Lettre = IIf(NumCol > 26, Chr(64 + NumCol \ 26) & Chr(64 + NumCol Mod 26), Chr(64 + NumCol))
            
            'Valeur par défaut
            Range("Clb").Value = "Hors Calibre"
            
            'Si résultat VlookUp = Vide: aller au pas de macro suivant
            On Error Resume Next
            
'Code1      Pourquoi ça ne marche pas, sauf pour les 3 premiers calibres du premier choix ?
'°°°°°      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
            'If Range("Pds").Value < Application.WorksheetFunction.VLookup(Range("Choix"), Range("D" & i & ":H" & i), j, False) _
            Then Range("Clb").Value = Range(Lettre & "2").Value _
            : Exit Sub
            
'Code 2     En passant par "Pds" et "Lettre", ça marche pour tous les choix et tous les calibres...!
'°°°°°°     Pds Application.WorksheetFunction.VLookup(Range("Choix"), Range("D" & i & ":H" & i), j, False)
            If Range("Pds").Value < Pds _
            Then Range("Clb").Value = Range(Lettre & "2").Value _
            : Exit Sub
            
'Code 3     Pourquoi ça ne marche plus en passant par "Cells" au ieu de "Lettre" ?
'°°°°°°     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
            'Pds = Application.WorksheetFunction.VLookup(Range("Choix"), Range("D" & i & ":H" & i), j, False)
            'If Range("Pds").Value < Pds _
            Then Range("Clb").Value = Range(Cells(2, j + 3)).Value _
            : Exit Sub

        Next j
    
    Next i

    ActiveSheet.Protect

End Sub

Merci de m'excuser d'encore solliciter tes lumières.

Cordialement 

Rataxes64

Application.WorksheetFunction.VLookup ?????

12 réponses

Votre réponse

sur les mêmes thèmes