Posez votre question Signaler

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

Messages postés
377
Date d'inscription
lundi 3 avril 2006
Statut
Membre
Dernière intervention
22 août 2018
 - - Dernière réponse : CerberusPau
Messages postés
377
Date d'inscription
lundi 3 avril 2006
Statut
Membre
Dernière intervention
22 août 2018
 - 24 févr. 2011 à 02:51
Visual Basic 6 Posez votre question Signaler
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
Afficher la suite 

12 réponses

Meilleure réponse
Signaler Commenter la réponse de CerberusPau
Messages postés
377
Date d'inscription
lundi 3 avril 2006
Statut
Membre
Dernière intervention
22 août 2018
3
Merci
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

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 190 internautes nous ont dit merci ce mois-ci

Commenter la réponse de CerberusPau
Signaler Commenter la réponse de CGSI3
Messages postés
416
Date d'inscription
vendredi 22 février 2008
Statut
Membre
Dernière intervention
7 janvier 2018
 1
0
Merci
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
Commenter la réponse de CGSI3
Signaler Commenter la réponse de CerberusPau
Messages postés
377
Date d'inscription
lundi 3 avril 2006
Statut
Membre
Dernière intervention
22 août 2018
0
Merci
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
Commenter la réponse de CerberusPau
Signaler Commenter la réponse de CGSI3
Messages postés
416
Date d'inscription
vendredi 22 février 2008
Statut
Membre
Dernière intervention
7 janvier 2018
 1
0
Merci
Nickel ! Tres clair.
Je regarde cela ce soir. (tard ..)
Il faut que je fouille dans mes archives ...
Bonne Journée CGSI3
Commenter la réponse de CGSI3
Signaler Commenter la réponse de bigfish_le vrai
Messages postés
1839
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
 8
0
Merci
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+
Commenter la réponse de bigfish_le vrai
Signaler Commenter la réponse de CGSI3
Messages postés
416
Date d'inscription
vendredi 22 février 2008
Statut
Membre
Dernière intervention
7 janvier 2018
 1
0
Merci
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
Commenter la réponse de CGSI3
Signaler Commenter la réponse de CerberusPau
Messages postés
377
Date d'inscription
lundi 3 avril 2006
Statut
Membre
Dernière intervention
22 août 2018
0
Merci
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
Commenter la réponse de CerberusPau
Signaler Commenter la réponse de bigfish_le vrai
Messages postés
1839
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
 8
0
Merci
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+
Commenter la réponse de bigfish_le vrai
Signaler Commenter la réponse de CerberusPau
Messages postés
377
Date d'inscription
lundi 3 avril 2006
Statut
Membre
Dernière intervention
22 août 2018
0
Merci
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
Commenter la réponse de CerberusPau
Signaler Commenter la réponse de bigfish_le vrai
Messages postés
1839
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
 8
0
Merci
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+
Commenter la réponse de bigfish_le vrai
Signaler Commenter la réponse de bigfish_le vrai
Messages postés
1839
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
 8
0
Merci
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+
Commenter la réponse de bigfish_le vrai
Signaler Commenter la réponse de CerberusPau
Messages postés
377
Date d'inscription
lundi 3 avril 2006
Statut
Membre
Dernière intervention
22 août 2018
0
Merci
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
Commenter la réponse de CerberusPau
Répondre Posez votre question