Microsoft 365 Macro pour renvoyer la valeur par rapport à un intervalle

chris6999

XLDnaute Impliqué
Bonjour le FORUM

Je suis en train d'essayer de monter une macro et plus je cherche moins je trouve...

Je suis sur une feuille où sont listés colonne A des chiffres (attention je peux avoir une nb de lignes important à traiter dans mon projet réel)
Je souhaiterais pouvoir définir pour chaque ligne examinée à quel intervalle correspond le chiffre renseigné.
Ma base de données pour définir les intervalles est dans la feuille BD dans laquelle sont définis 60 intervalles :
col A valeur minimale
con B valeur maximale
Col C et D Le libellé de l'intervalle et le numéro du portefeuille que je souhaite remonter dans la feuille traitée.

Pour trouver l'intervalle le chiffre doit être >= à MIN et <= à MAX

Pour que ce soit plus clair je mets un fichier TEST en PJ.

J'espère que ce sujet vous inspire car moi je ne sais plus par quel bout le prendre

Merci par avance pour votre aide
Bonne soirée à tous
 

Pièces jointes

  • TEST_Portfeuille correspondant à l'intervalle.xlsm
    115.2 KB · Affichages: 3

Phil69970

XLDnaute Barbatruc
Bonjour @chris6999

Je te propose

En B5 de la feuille 2 :
=RECHERCHEV(INDEX(BD!$B$5:$B$64;EQUIV(A5;BD!$A$5:$A$64));BD!$B$5:$D$64;2;FAUX)
A tirer vers le bas

En C5 de la feuil2 :
=RECHERCHEV(INDEX(BD!$B$5:$B$64;EQUIV(A5;BD!$A$5:$A$64));BD!$B$5:$D$64;3;FAUX)
A tirer vers le bas

Et tu auras ceci colonne B et C

1706286497186.png

Merci de ton retour
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Chris,
Un essai en PJ avec ces formules :
VB:
Intervalle   : =INDEX(BD!$C$5:$C$64;1+ENT(A5/(1+BD!$B$1)))
Portefeuille : =INDEX(BD!$D$5:$D$64;1+ENT(A5/(1+BD!$B$1)))
Il est alors simple de mettre ça en macro si vous tenez à avoir une macro.
 

Pièces jointes

  • TEST_Portfeuille correspondant à l'intervalle.xlsm
    546.9 KB · Affichages: 1

Franc58

XLDnaute Occasionnel
Salut, comme tu cherchais un code macro, en voici un:

VB:
Sub CopierValeurs()
    Dim wsBD As Worksheet
    Dim wsFeuil2 As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim i As Long
    Dim L As Long
    Dim R As Long
    Dim M As Long

    Set wsBD = ThisWorkbook.Sheets("BD")
    Set wsFeuil2 = ThisWorkbook.Sheets("Feuil2")

    Set rng = wsFeuil2.Range("A5:A" & wsFeuil2.Cells(wsFeuil2.Rows.Count, "A").End(xlUp).Row)

    For Each cell In rng
        L = 5
        R = wsBD.Cells(wsBD.Rows.Count, "A").End(xlUp).Row
        Do While L <= R
            M = L + (R - L) \ 2
            If cell.Value >= wsBD.Cells(M, "A").Value And cell.Value <= wsBD.Cells(M, "B").Value Then
                cell.Offset(0, 1).Value = wsBD.Cells(M, "C").Value
                cell.Offset(0, 2).Value = wsBD.Cells(M, "D").Value
                Exit Do
            ElseIf cell.Value < wsBD.Cells(M, "A").Value Then
                R = M - 1
            Else
                L = M + 1
            End If
        Loop
    Next cell
End Sub
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonsoir Chris, Franc,
Les mêmes formules, mais en macro. Elle s'exécute automatiquement lorsqu'on sélectionne la Feuil2 :
VB:
Sub Worksheet_Activate()
    Dim DL: DL = [A65000].End(xlUp).Row
    [B5:B65000].ClearContents
    Range("B5:B" & DL).Formula = "=INDEX(BD!R5C3:R64C3,1+INT(RC[-1]/(1+BD!R1C2)))"
    Range("C5:C" & DL).Formula = "=INDEX(BD!R5C4:R64C4,1+INT(RC[-2]/(1+BD!R1C2)))"
    Range("B5:C" & DL) = Range("B5:C" & DL).Value
End Sub
 

Pièces jointes

  • TEST_Portfeuille correspondant à l'intervalle (1).xlsm
    148.8 KB · Affichages: 3

Discussions similaires

Statistiques des forums

Discussions
312 886
Messages
2 093 275
Membres
105 667
dernier inscrit
maxmichel