Recherche valeur proche vbaRésolu

Question

bonjour,

voilà, j'ai 2 tableau de 2 colonnes avec des valeurs numériques dans les premières colonnes et du texte dans les secondes.
j'inscris des valeurs dans le 2 ème tableau et dans la 1 ère colonne, j'aimerais que la valeur soit recherchée dans mon premier tableau mais Supérieur ou égale à celle-ci au plus proche.
exemple : 
850	Profil 1	                    	1580	
1200	Profil 2			
1900	Profil 3			
1340	Profil 4			
1750	Profil 5			
950	Profil 6			
896	Profil 7			

résultat :
850	Profil 1		1580	Profil 5
1200	Profil 2			
1900	Profil 3			
1340	Profil 4			
1750	Profil 5			
950	Profil 6			
896	Profil 7			

j'ai bien réussi à faire une macro pour faire une recherche de la valeur exacte mais dès que je cherche la valeur proche il me donne le profil 7

Sub test()
      maDonnee = Range("G7").Value
        If Not IsError(Application.VLookup(maDonnee, Worksheets("Feuil1").Range("D7:E13"), 2, True)) Then
           Range("G7").Offset(0, 1).Value = (Application.VLookup(maDonnee, Worksheets("Feuil1").Range("D7:E13"), 2, True))

        End If
End Sub

j'aimerais bien comprendre d'ou vient mon erreur?
si quelqu'un à un idée et  même par à un autre moyen, je suis preneur!!
merci

ucfoutu · Accepted Answer

Mais l'idée n'étant pas mauvaise en soi, je me suis attaché à la mettre en oeuvre avec autre chose que la méthode filter.
Regarde ce que fait ceci :

Private Sub CommandButton1_Click()
 Dim maplage As Range, mavaleur As Double
 Set maplage Range("A1:A10") '>> ici la plage de ton choix
 mavaleur = 4 '===>> ici la valeur de ton choix ou référence à celle d'une cellule
 MsgBox nbapproche(maplage, mavaleur)
End Sub
Private Function nbapproche(plage As Range, nob As Double) As Double
  Dim tabl() As Variant
  ReDim retenu(1 To 1) As Double
  tabl = plage
  nb = 0
  For i = 1 To UBound(tabl)
   If tabl(i, 1) >= nob Then
     nb = nb + 1
     ReDim Preserve retenu(1 To nb)
     retenu(nb) = tabl(i, 1)
   End If
  Next
  nbapproche = Application.Min(retenu)
End Function
Cette fonction, comme tu le vois, va te retourner la plus petite valeur >= à la valeur de ton choix.
Que te reste-til à faire ? ===>> simple : Utiliser maintenant Find pour trouver sur quelle ligne est cette valeur et extirper' le profil y correspondant 
Qu'en penses-tu ?

____________________
Vous aimez Codes-Sources ? Il vous aide ? Cliquez ici pour l'aider à continuer
Cliquer sur "Réponse acceptée"  en bas d'une solution adéquate est

cs_Jack · Answer

Salut

La seule solution que je connaisse consiste à classer les données par ordre croissant (ou pourquoi pas décroissant) avant de commencer la recherche. De cette manière, il sera possible de dire 'si la donnée est supérieure (ou inférieure), alors j'ai dépassé la cible et je m'arrête là.
Donc, d'abord, classer les données avant de lire, ligne à ligne les données et les comparer.
Si le nombre de données est très important (plus de 5000), tu peux avoir recours à une recherche dichotomique pour accélérer les choses : Tu tapes la donnée centrale de la liste : Si la valeur cible est inférieure, tu tapes la moitié de la partie inférieure, sinon, tu tapes la moitié de la partie supérieure, etc, jusqu'à ce que les seuils inférieur et supérieur soient successifs = gain de 1 pour 5 (une recherche de ce type dans un dictionnaire (d'où le nom) de 30.000 mots permet de trouver un résultat en moins de 20 requètes)

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)

ucfoutu · Answer

Bonjour,

Je n'ai pas actuellement Excel sous la main pour vérifier.
J'essaye donc de mémoire :
A essayer :
Utilisation de la méthode Filter avec argument compare >la_valeur>> obtention d'un array contenant toutes les valeurs ainsi trouvées ===>> recherche de la valeur minimum dans cet Array (par application.min, je crois)

Mille excuses si "à côté de la plaque", mais je ne réponds que de mémoire .... et ne peux rien vérifier.




____________________
Vous aimez Codes-Sources ? Il vous aide ? Cliquez ici pour l'aider à continuer
Cliquer sur "Réponse acceptée"  en bas d'une solution adéquate est

ucfoutu · Answer

Ah oui !
Comme il faut retourner non pas la valeur la plus proche, mais le "profil" ===>> terminer en recherchant cette fois-ci le minimum de l'array (voir au dessus) ===>> retourner la cellule de même ligne de la colonne des profils.


____________________
Vous aimez Codes-Sources ? Il vous aide ? Cliquez ici pour l'aider à continuer
Cliquer sur "Réponse acceptée"  en bas d'une solution adéquate est

ucfoutu · Answer

Aïe !
J'ai maintenant Excel sous la main et ===>> ce que j'ai dit plus haut est à oublier (l'argument compare ne prévoit pas ce que je pensais).
Mes excuses les plus plates, donc.


____________________
Vous aimez Codes-Sources ? Il vous aide ? Cliquez ici pour l'aider à continuer
Cliquer sur "Réponse acceptée"  en bas d'une solution adéquate est

boomer11 · Answer

salut, 

Merci jack et ucfoutu pour vos réponse.

j'ai effectivement essayer la methode de jack mais elle me donne toujours la valeur inferieur la plus proche.
En revanche ta macro fonctionne à merveille, milles mercis!!!
j'avais planché un peu de mon coté et j'étais reparti dans un truc plus simple en triant la colonne par ordre croissant puis en faisant une boucle pour chercher la valeur >= la plus proche
Sub test()
      Set d = Range("D7:D13")
      Set maDonnee = Range("G7")
    For Each c In d
    If c.Value >= maDonneeThen
        [maDonnee].Offset(0, 1).Value = c.Offset(0, 1).Value
    Exit Sub
    End If
  Next
     End Sub

Ce qui me donne un résultat presque satisfaisant sous condition d'avoir trié la plage avant!!!
Cependant je m'atèle à étudier ta fonction car je n'ai pas l'habitude d'en utiliser.
Comme tu me l'as suggérré, je fais donc une recherche avec find pour trouver ma valeur et en prendre la valeur de la cellule à coté.
Sub recherche()
Dim maplage As Range, mavaleur As Double
 Set maplage Range("A1:A10") '>> ici la plage de ton choix
 mavaleur = Range("D1").Value '===>> ici la valeur de ton choix ou référence à celle d'une cellule
 Dim MaCellule As Range
 n = nbapproche(maplage, mavaleur) 'je stock la valeur
On Error Resume Next
Set MaCellule = maplage.Find(n, , xlValues).Select ' je la cherche en la selectionnant
Range("E1").Value = Selection.Offset(0, 1).Value ' je prends la valeur à coté
End Sub

il y a surement mieux mais comme tu l'as compris je suis un peu novice donc je fais un peu avec les moyens du bord!!
En tout cas un grand merci tout marche à merveille

ucfoutu · Answer

Tout d'abord : 
content pour toi.

Ensuite :
...il y a surement mieux...
Oui. Mais un peu plus lourd (ajout d'une référence supplémentaire)
Tu sais comment ? ==>> transformer la plage en pseudo-recordset (c'est un petit "truc") avec 2 "champs" (profil et valeur) et y faire une requête avec le champ_valeur >= ta_valeur, te tout trié (tri croissant sur champ_valeur) ===>> ne garder que le premier résultat du champ_profil.
Cette solution reste chère et n'est à mon avis valable que si ton application utilise ce genre de "truc" (et donc cette référence supplémentaire) à d'autres fins ici et là.


____________________
Vous aimez Codes-Sources ? Il vous aide ? Cliquez ici pour l'aider à continuer
Cliquer sur "Réponse acceptée"  en bas d'une solution adéquate est

ucfoutu · Answer

Ah oui :
...Cependant je m'atèle à étudier ta fonction...
Je la commente donc pour te faciliter cette étude

Private Function nbapproche(plage As Range, nob As Double) As Double
  Dim tabl() As Variant '==>> 1) je vais travailler sur un 1er tableau dynamique (voir plus bas)
  'je vais également alimenter un 2ème tableau/Array par les
'seules valeurs au moins égales à celle de ma recherche
  ReDim retenu(1 To 1) As Double
  '==>> voir 1) : les éléments de mon tableau dynamique
'seront les valeurs de ma plage.
'parcourir un tel tableau est beaucoup plus rapide
'que de parcourir les cellules de la feuille
  tabl = plage 

  nb = 0
  For i = 1 To UBound(tabl) 'je parcours l'ensemble des éléments du tableau ainsi constitué
   If tabl(i, 1) >= nob Then 'si donc répond au critère
     nb = nb + 1
     ReDim Preserve retenu(1 To nb) 'j'augmente la taille de mon array
'et ajoute à sa fin la valeur répondant au critère
     retenu(nb) = tabl(i, 1) ' et 
   End If
  Next
'j'extrait maintenant la plus petite valeur des valeurs retenues
  nbapproche = Application.Min(retenu)
End Function

Voilà



____________________
Vous aimez Codes-Sources ? Il vous aide ? Cliquez ici pour l'aider à continuer
Cliquer sur "Réponse acceptée"  en bas d'une solution adéquate est

ucfoutu · Answer

Et pour tout te dire :
On pourrait écrire la fonction pour qu'elle retourne directement le profil, plutôt que la valeur. 
Je n'ai pas voulu le faire. Pourquoi ? ===>
Une telle fonction ne t'aurait servi qu'à toi, pour ton besoin précis, alors que, telle que conçue et retournant la plus petite parmi un lot de valeurs supérieures ou égales à une valeur donnée, elle pourra répondre aux besoins éventuels d'autres forumeurs.

____________________
Vous aimez Codes-Sources ? Il vous aide ? Cliquez ici pour l'aider à continuer
Cliquer sur "Réponse acceptée"  en bas d'une solution adéquate est

boomer11 · Answer

Encore merci,
Tes messages sont vraiement complets et instructifs. 
Tes commentaires vont me permettre d'appronfondir mes applications et d'en améliorer mes synthaxes à l'avenir!

Celui qui se sera étudié lui-même sera bien avancé dans la connaissance des autres.(Diderot)

Recherche valeur proche vba

10 réponses

Votre réponse

Discussions similaires