Remise

Résolu
94michel Messages postés 38 Date d'inscription   Statut Membre Dernière intervention   -  
yg_be Messages postés 24281 Statut Contributeur -
Bonjour, et merci à vous tous pour votre aide.

je voudrais savoir si c'est possible sur un tableau avec plusieurs montants de savoir exactement les montants utilisés pour une remise spécifique.

encore une fois merci beaucoup

https://mon-partage.fr/f/BvpFC0e9/

3 réponses

Réponse 1 / 3
yg_be Messages postés 24281 Statut Contributeur Ambassadeur 1 584
 
bonjour, que veux-tu calculer?
0
94michel Messages postés 38 Date d'inscription   Statut Membre Dernière intervention  
 
bonjour,
une remise de 4637,60€ avec un tableau de plusieurs montant en sélectionnant automatiquement les montants de la somme en remise.
merci
0
yg_be Messages postés 24281 Statut Contributeur 1 584 > 94michel Messages postés 38 Date d'inscription   Statut Membre Dernière intervention  
 
que faut-il avoir comme résultat dans quelle cellule?
0
94michel Messages postés 38 Date d'inscription   Statut Membre Dernière intervention  
 
j'ai envoyé le fichier excel en modèle sur mon partage, il faut juste par exemple changer la couleur des montants de chaque cellule pour arriver à la remise voulue.
les cellules des colonnes A B C D sur 15 lignes sont notes des montants, dans la cellule E 1 le montant de la remise,idéal est une sélection automatique sur les connes A B C D des montants pour arriver à la remise.

Merci
0
yg_be Messages postés 24281 Statut Contributeur 1 584 > 94michel Messages postés 38 Date d'inscription   Statut Membre Dernière intervention  
 
je vois bien tous les montants, mais je n'ai pas compris quel était le résultat final attendu.
je ne comprends pas "changer la couleur", ni "arriver à la remise".
0
Ghörgh Messages postés 6311 Statut Contributeur 1 244
 
Si je comprend bien, tu veux que le fichier cherche les cellules dans A1:D15 qui additionnées font le montant que tu rentres en E1.
C'est bien ça ?
Si c'est le cas, le problème est qu'il y a plusieurs combinaison possible...
Du coup sans plus de règles...
0
Réponse 2 / 3
yg_be Messages postés 24281 Statut Contributeur Ambassadeur 1 584
 
suggestion: 
Option Explicit

Type Coupon
     addr As String
     val As Currency
     selected As Boolean
End Type
Sub remise()
Dim tout As Range, cell As Range, coll() As Coupon, nbr As Integer, remise As Currency, i As Integer
Set tout = Sheets("Feuil1").[A1:D15]
remise = CCur(Sheets("Feuil1").[E1])
nbr = 0
For Each cell In tout
    If IsNumeric(cell) And cell <> "" Then
        nbr = nbr + 1
        ReDim Preserve coll(nbr)
        coll(nbr).addr = cell.address
        coll(nbr).val = CCur(cell.Value)
        coll(nbr).selected = False
    End If
Next cell
If match(remise, coll, 1) Then
    Debug.Print "ok"
    For i = 1 To nbr
        If coll(i).selected Then
            Debug.Print coll(i).val, coll(i).addr
            Sheets("Feuil1").Range(coll(i).addr).Font.ColorIndex = 3
        Else
            Sheets("Feuil1").Range(coll(i).addr).Font.ColorIndex = 1
        End If
    Next i
Else
    Debug.Print "NOK"
End If
End Sub
Private Function match(reste As Currency, coll() As Coupon, depth As Integer) As Boolean
If coll(depth).val = reste Then
    coll(depth).selected = True
    match = True
Else
    If depth = UBound(coll) Then
        match = False
    Else
        If match(reste, coll, depth + 1) Then
            match = True
        Else
            If coll(depth).val < reste Then
                coll(depth).selected = True
                If match(reste - coll(depth).val, coll, depth + 1) Then
                    match = True
                Else
                    coll(depth).selected = False
                    match = False
                End If
            End If
        End If
    End If
End If
End Function
0
yg_be Messages postés 24281 Statut Contributeur 1 584
 
variante: 
Option Explicit

Type Coupon
     addr As String
     val As Currency
     selected As Boolean
End Type
Sub remise()
Dim tout As Range, cell As Range, coll() As Coupon, nbr As Integer, remise As Currency, i As Integer, total As Currency
Dim kp As Coupon
Set tout = Sheets("Feuil1").[A1:D15]
remise = CCur(Sheets("Feuil1").[E1])
nbr = 0
total = 0
For Each cell In tout
    If IsNumeric(cell) And cell <> "" Then
        nbr = nbr + 1
        ReDim Preserve coll(nbr)
        coll(nbr).addr = cell.address
        coll(nbr).val = CCur(cell.Value)
        total = total + coll(nbr).val
        coll(nbr).selected = False
    End If
Next cell
If match(remise, coll, 1, total) Then
    Debug.Print "ok"
    For i = 1 To nbr
        If coll(i).selected Then
            Debug.Print coll(i).val, coll(i).addr
            Sheets("Feuil1").Range(coll(i).addr).Font.ColorIndex = 4
        Else
            Sheets("Feuil1").Range(coll(i).addr).Font.ColorIndex = 1
        End If
    Next i
Else
    Debug.Print "NOK"
        For i = 1 To nbr
            Sheets("Feuil1").Range(coll(i).addr).Font.ColorIndex = 3
    Next i
End If
End Sub
Private Function match(reste As Currency, coll() As Coupon, depth As Integer, grandtotal As Currency) As Boolean
Dim curval As Currency, totalrestant As Currency
DoEvents
curval = coll(depth).val
If curval = reste Then
    coll(depth).selected = True
    match = True
    Exit Function
End If
If depth = UBound(coll) Then
    match = False
    Exit Function
End If
If curval < reste Then
    If match(reste - curval, coll, depth + 1, grandtotal - curval) Then
        coll(depth).selected = True
        match = True
        Exit Function
    End If
End If
totalrestant = grandtotal - curval
If reste <= totalrestant Then
    If match(reste, coll, depth + 1, totalrestant) Then
        match = True
        Exit Function
    End If
End If
match = False
End Function
0
94michel Messages postés 38 Date d'inscription   Statut Membre Dernière intervention  
 
merci beaucoup
ça fonctionne très bien
bonne soirée
0
yg_be Messages postés 24281 Statut Contributeur 1 584 > 94michel Messages postés 38 Date d'inscription   Statut Membre Dernière intervention  
 
couleurs améliorées: 
Option Explicit

Type Coupon
     addr As String
     val As Currency
     selected As Boolean
End Type
Sub remise()
Dim tout As Range, cell As Range, coll() As Coupon, nbr As Integer, remise As Currency, i As Integer, total As Currency
Dim kp As Coupon
Sheets("Feuil1").[E1].Font.ColorIndex = 1
Set tout = Sheets("Feuil1").[A1:D15]
remise = CCur(Sheets("Feuil1").[E1])
nbr = 0
total = 0
For Each cell In tout
    If IsNumeric(cell) And cell <> "" Then
        nbr = nbr + 1
        ReDim Preserve coll(nbr)
        coll(nbr).addr = cell.address
        coll(nbr).val = CCur(cell.Value)
        total = total + coll(nbr).val
        coll(nbr).selected = False
    End If
Next cell
For i = 1 To nbr
    Sheets("Feuil1").Range(coll(i).addr).Font.ColorIndex = 1
Next i
If match(remise, coll, 1, total) Then
    Debug.Print "ok"
    Sheets("Feuil1").[E1].Font.ColorIndex = 4
    For i = 1 To nbr
        If coll(i).selected Then
            Debug.Print coll(i).val, coll(i).addr
            Sheets("Feuil1").Range(coll(i).addr).Font.ColorIndex = 4
        Else
            Sheets("Feuil1").Range(coll(i).addr).Font.ColorIndex = 1
        End If
    Next i
Else
    Debug.Print "NOK"
    Sheets("Feuil1").[E1].Font.ColorIndex = 3
    For i = 1 To nbr
        Sheets("Feuil1").Range(coll(i).addr).Font.ColorIndex = 3
    Next i
End If
End Sub
Private Function match(reste As Currency, coll() As Coupon, depth As Integer, grandtotal As Currency) As Boolean
Dim curval As Currency, totalrestant As Currency
DoEvents
curval = coll(depth).val
If curval = reste Then
    coll(depth).selected = True
    match = True
    Exit Function
End If
If depth = UBound(coll) Then
    match = False
    Exit Function
End If
If curval < reste Then
    If match(reste - curval, coll, depth + 1, grandtotal - curval) Then
        coll(depth).selected = True
        match = True
        Exit Function
    End If
End If
totalrestant = grandtotal - curval
If reste <= totalrestant Then
    If match(reste, coll, depth + 1, totalrestant) Then
        match = True
        Exit Function
    End If
End If
match = False
End Function
0
Réponse 3 / 3
JvDo Messages postés 2012 Statut Membre 859
 
Bonjour à tous,

eriiic a fait un travail intéressant sur la question que tu poses.
Si tu cherches toutes les solutions ou seulement un certain nombre, je te conseille de regarder son travail.

Si tu veux une solution, tu peux, en dehors de la macro de yg_be, utiliser le solveur d'excel.
Tu crées une zone (mes_variables_binaires) de même dimension que tes montants (15 par 4) et tu lui donnes la contrainte d'être binaire.
tu crées une formule : ma_remise-sommeprod(mes_montants*mes_variables_binaires) qui deviendra ton objectif avec valeur 0.

Tu choisis "simplexe" et tu lances le solveur qui te fournit une solution.

Tu peux mettre une MFC sur la zone de tes montants pour faire ressortir les valeurs choisies.


Cordialement
0
94michel Messages postés 38 Date d'inscription   Statut Membre Dernière intervention  
 
Bonsoir
merci pour cette solution, mais je ne comprends pas trop, si tu peux m'envoyer mon fichier avec ta formule intégrée ça ne serait pas de refus.
bonne soirée

Encore une fois Merci a vous tous.
0

Discussions similaires

Vente en main propre sur leboncoin
John -
Afrikarnak -

2 réponses
Paiement Leboncoin
JamesDu76 -
contrariness -

2 réponses
formule excel avec une remise en %
Thierry -
kriss -

15 réponses
remise a zero compteur epson
patcat17 -
Norberto -

14 réponses
Calculer une remise dans un tableau excel
Catminette -
Catminette -

2 réponses