vba recherche informations dans liste Fermé

Question

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

Configuration: Windows 7 / Safari 534.16

ccm81 · Answer

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

tutitou · Answer

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!!!!

ccm81 · Answer

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 exemplesheets("Feuil2").Cells(li,6)      

bonne suite

ccm81 · Answer

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

Vba recherche informations dans liste

4 réponses

Discussions similaires