CerberusPau377
Messages postés lundi 3 avril 2006Date d'inscription
22 août 2018
Dernière intervention
-
7 févr. 2011 à 10:46 - Dernière réponse : CerberusPau377
Messages postés lundi 3 avril 2006Date d'inscription
22 août 2018
Dernière intervention
- 24 févr. 2011 à 02:51
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.
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 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.
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
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!!!
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
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
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
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
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.
a aidé 97 internautes ce mois-ci