Vba recherche informations dans liste

tutitou -  
Bonjour,

Je voudrais réaliser une macro

J'ai un tableau avec des noms d'analyse (colonne E) et des chiffres liés au nom (colonne F). En colonne A, j'ai d'autres chiffres.
Je voudrais écrire, automatiquement (colonne B) à l'aide d'une macro, le nom des analyses lorsque la valeur de la colonne F est la plus proche par rapport à la colonne A.

Je m'explique :
Colonne E :...........Colonne F :
EF10......................... 45
EF50........................ 150
AG12......................... 220

Si en colonne A, j'ai une valeur égale à 175, je souhaiterai voir écrit EF50 et non EF45.

D'après ce que j'ai "réussi à faire", je n'arrive que à avoir EF10 car il me prend le premier nombre inférieur qu'il trouve et pas l'inférieur le plus proche.

Voici ce que j'ai fait :
Public Sub Comparaison()
Dim cel As Range
Dim x As Integer

For x = 1 To 21

For Each cel In Range("Feuil1!B2:B15")
If cel.Offset(0, -1).Value <= [F1].Offset(x, 0).Value Then cel.Value = [E1].Offset(x, 0).Value

Next cel
Next x

End Sub

MMMMMERRRRRCI DE VOTRE AIDE, JE SUIS PERDUE

4 réponses

  1. ccm81
    bonjour

    est ce que ceci répond à la question (modifier les constantes) 

    Private Sub CommandButton1_Click()
Const limin = 1
Const limax = 7
Dim li As Long, lili As Long, libonne As Long
libonne = limin
For lili = limin To limax
  libonne = 1
  For li = limin To limax
    If Cells(li, 6) <= Cells(lili, 1) Then
      If Cells(libonne, 6) < Cells(li, 6) Then
        libonne = li
      End If
    End If
  Next li
  Cells(lili, 2).Value = Cells(libonne, 5)
Next lili
End Sub


    bonne suite
    1. tutitou
      Merci!
      Ca marche bien mais comment je peux faire pour :
      - ne mettre aucune valeur dans la colonne B si la valeur en A est supérieure à la plus grande valeur de F (par exemple, si A=100 et que maxF=50, on n'écrit rien en B car je recherche la valeur inférieure la plus proche et non la valeur supérieure la plus proche).
      - je n'ai pas du comprendre toute la subtilité de votre code car je ne réussi pas à faire la même chose en cherchant la valeur supérieure la plus proche.
      - qu'est ce que je dois changer pour mettre les données (actuellement en colonnes E et F) dans une autre feuille?
      Merci de vos réponses!!!!
      1. ccm81
        re

        Q1. si j'ai bien compris la question 
        Option Explicit       

Private Sub CommandButton1_Click()       
Const limin = 1       
Const limax = 7       
Dim li As Long, lili As Long, libonne As Long       
Dim maxF       
For lili = limin To limax       
  maxF = Application.WorksheetFunction.Max(Cells(limin, 6), Cells(limax, 6))    
  If maxF > Cells(lili, 1) Then       
    libonne = 1       
    For li = limin To limax       
      If Cells(li, 6) <= Cells(lili, 1) Then       
        If Cells(libonne, 6) < Cells(li, 6) Then       
          libonne = li       
        End If       
      End If       
    Next li       
    Cells(lili, 2).Value = Cells(libonne, 5)       
  Else       
    Cells(lili, 2).Value = ""       
  End If       
Next lili       
End Sub


        Q2. que veux tu dire par qu'est ce que je dois changer pour mettre les données (actuellement en colonnes E et F) dans une autre feuille?
        est ce que ne serait pas plutot "prendre les données"
        quoiqu'il en soit (prendre ou mettre), il te suffit de mettre un sheets(nom_de_ta_feuille). devant tous les cells et range, sans oublier le "."
        ex 
        cells(li,6)
        devient par exemple
        sheets("Feuil2").Cells(li,6)


        bonne suite
        1. ccm81
          pour compléter le post précedent
          les colonnes E et F sont dans Feuil2 et A et B dans Feuil1 

          Option Explicit

Private Sub CommandButton1_Click()
Const limin = 1
Const limax = 7
Const FD = "Feuil2"
Const FR = "Feuil1"
Dim li As Long, lili As Long, libonne As Long
Dim maxF
For lili = limin To limax
  With Sheets(FD)
    maxF = Application.WorksheetFunction.Max(.Cells(limin, 6), .Cells(limax, 6))
  End With
  If maxF > Cells(lili, 1) Then
    libonne = limin
    For li = limin To limax
      If Sheets(FD).Cells(li, 6) <= Sheets(FR).Cells(lili, 1) Then
        If Sheets(FD).Cells(libonne, 6) < Sheets(FD).Cells(li, 6) Then
          libonne = li
        End If
      End If
    Next li
    Sheets(FR).Cells(lili, 2).Value = Sheets(FD).Cells(libonne, 5)
  Else
    Sheets(FR).Cells(lili, 2).Value = ""
  End If
Next lili
End Sub


          bonne suite