Recherche de plusieurs valeur avec condition VBA + msgbox
Bonjour à tous,
J'ai créé un petit programme qui permets de calculer l'IMC d'une personne en VBA en affichant un usf. Jusque là aucun soucis.
Cependant, j'aimerai rajouter une formule qui : Rechercherai la même valeur dans la colonne A à partir du textbox1 (taille) et rechercherai la valeur du textbox 2 (poids) sur la même ligne pour afficher la valeur de la cellule b1 ou d1 ou f1 etc .. selon la valeurs comprise entre b3 et c3 par exemple de ma valeur de ma textbox 2 et l'afficherai dans ma msgbox.
Ce qui ferait par exemple sur le msgbox Imc = 50, refus (dans mon usf, "IMC = 50" est déjà incrémenté)
J'ai commencé à remplir les deux lignes en exemple pour commencer à réfléchir à une piste de formule vba ou excel mais là le cale...
En espérant avoir été clair, mais c'est un peu difficile d'expliquer cela par écrit...
Merci d'avance pour votre aide !
Bonjour,
à tester,
imc = CDbl(TextBox2) / ((CDbl(TextBox1) / 100) ^ 2)après quelques recherches, j'ai trouvé cela :
Private Sub CommandButton1_Click()
Dim var As String
MsgBox "imc =" & Chr(10) & Val(TextBox2 / (TextBox1 / 100) ^ 2) & Range("w1")
MsgBox IMC(Worksheets("Feuil1"))
End Sub
Function IMC(Fe As Worksheet) As String
Dim Plage As Range
Dim Cel As Range
Dim Lig As Long
With Fe: Set Plage = .Range(.Cells(3, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With
Set Cel = Plage.Find(Int(TextBox1.Text), , xlValues, xlWhole)
If Not Cel Is Nothing Then
Lig = Cel.Row
With Fe: Set Plage = .Range(.Cells(Lig, 2), .Cells(Lig, .Columns.Count).End(xlToLeft)): End With
End If
Set Cel = Plage.Find(Int(TextBox2.Text), , xlValues, xlWhole)
If Not Cel Is Nothing Then
IMC = Fe.Cells(1, IIf(Fe.Cells(1, Cel.Column).Value = "", Cel.Column - 1, Cel.Column)).Value
End If
End FunctionCependant quand je tape une valeur qui est différente de 21 et de 30 mais comprise entre ces chiffres, je n'ai pas le résultat (refus ...). Comment peut-on faire pour incrémenter cela ?
Bonjour,
comment détermines-tu les différentes valeurs min et max de ton tableau en feuil1
sur wikipedia on retrouve ces différentes catégories pour l'IMC
IMC (kg·m−2) Interprétation
moins de 16,5 dénutrition ou anorexie
16,5 à 18,5 maigreur
18,5 à 25 corpulence normale
25 à 30 surpoids
30 à 35 obésité modérée
35 à 40 obésité sévère
plus de 40 obésité morbide ou massive
si tu pars de ce principe, tu demandes le poids et la taille, tu calcules l'IMC et tu compares avec le tableau ci-dessus ou un tableau semblable pour déterminer la catégorie, pas de besoin de tableau type celui que tu as mis en feuil1
Bonjour,
C'est le code que je t'ai donné hier sur un autre forum !
Si des valeurs sont entrées entre les bornes, il suffit de rechercher la valeur égale ou immédiatement supérieure dans la plage :
Function IMC(Fe As Worksheet) As String
Dim Plage As Range
Dim Cel As Range
Dim Lig As Long
With Fe: Set Plage = .Range(.Cells(3, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With
Set Cel = Plage.Find(Int(TextBox1.Text), , xlValues, xlWhole)
If Not Cel Is Nothing Then
Lig = Cel.Row
With Fe: Set Plage = .Range(.Cells(Lig, 2), .Cells(Lig, .Columns.Count).End(xlToLeft)): End With
End If
For Each Cel In Plage
'les valeurs étant de la gauche veres la droite de la plus petite à la plus grande, il suffit de rechercher
'la valeur immédiatement supérieure !
If Cel.Value >= Int(TextBox2.Text) Then
IMC = Fe.Cells(1, IIf(Fe.Cells(1, Cel.Column).Value = "", Cel.Column - 1, Cel.Column)).Value
Exit Function
End If
Next Cel
End Functionla fonction IIf() est utilisée car les cellules en ligne 1 sont fusionnées ce qui n'est pas conseillé pour un bon fonctionnement du classeur !
Tu peux entrer la même valeur dans les deux cellules et utiliser un format personalisé ";;;" (trois point-virgules) pour masquer la valeur.