Menu

Remise [Résolu]

Messages postés
24
Date d'inscription
mardi 12 juin 2018
Statut
Membre
Dernière intervention
11 juillet 2019
- - Dernière réponse : yg_be
Messages postés
8067
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
19 juillet 2019
- 12 juil. 2019 à 08:53
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/
Afficher la suite 

3 réponses

Messages postés
8067
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
19 juillet 2019
397
0
Merci
bonjour, que veux-tu calculer?
Ghörgh
Messages postés
10968
Date d'inscription
mardi 19 janvier 2010
Statut
Contributeur
Dernière intervention
19 juillet 2019
827 -
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...
94michel
Messages postés
24
Date d'inscription
mardi 12 juin 2018
Statut
Membre
Dernière intervention
11 juillet 2019
-
exemple une remise de 100€ en E 1
il y a dans les colonnes les montants suivants 10 € 50 € 30 € 99 € 10 €
la sélection est 10 € 50 € 30 € 10 € pour arriver a 100€ de remise pour différencier ces chiffre il faut changer la couleur par exemple
merci
Ghörgh
Messages postés
10968
Date d'inscription
mardi 19 janvier 2010
Statut
Contributeur
Dernière intervention
19 juillet 2019
827 > 94michel
Messages postés
24
Date d'inscription
mardi 12 juin 2018
Statut
Membre
Dernière intervention
11 juillet 2019
-
Oui mais si ta remise est 349€ par exemple, tu peux le faire avec 120+130+99. Sachant que dans les colonnes, il y a :
8 fois 99€
2 fois 120€
1 fois 130€
Comment on peut définir quelle cellule de 99€ et 120€ on choisit ?
Et pour aller plus loin, en prenant cette même remise, on peut aussi faire :
90+129+130
ou
60+90+100+99
etc...

Si il n'y a pas d'autre règle, ça me parait complexe.
Sachant déjà qu'à la base, c'est pas simple je pense de faire la macro que tu souhaites.
94michel
Messages postés
24
Date d'inscription
mardi 12 juin 2018
Statut
Membre
Dernière intervention
11 juillet 2019
-
merci pour votre aide
il faut utiliser une seule fois un montant si par exemple il y a 2 montants de 99€ on en utilisera que 1,
peu importe 90+129+130 ou 60+90+100+99 du moment que la somme est de 349€ donc la sélection sera 90+129+130 par exemple.
yg_be
Messages postés
8067
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
19 juillet 2019
397 > 94michel
Messages postés
24
Date d'inscription
mardi 12 juin 2018
Statut
Membre
Dernière intervention
11 juillet 2019
-
tu souhaites automatiquement sélectionner des cellules de façon à ce que le total du montant de ces cellules soit égal au contenu de la cellule E1?
Commenter la réponse de yg_be
Messages postés
8067
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
19 juillet 2019
397
0
Merci
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

yg_be
Messages postés
8067
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
19 juillet 2019
397 -
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
94michel
Messages postés
24
Date d'inscription
mardi 12 juin 2018
Statut
Membre
Dernière intervention
11 juillet 2019
-
merci beaucoup
ça fonctionne très bien
bonne soirée
yg_be
Messages postés
8067
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
19 juillet 2019
397 > 94michel
Messages postés
24
Date d'inscription
mardi 12 juin 2018
Statut
Membre
Dernière intervention
11 juillet 2019
-
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
Commenter la réponse de yg_be
Messages postés
1935
Date d'inscription
mercredi 27 juillet 2005
Statut
Membre
Dernière intervention
11 juillet 2019
751
0
Merci
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
94michel
Messages postés
24
Date d'inscription
mardi 12 juin 2018
Statut
Membre
Dernière intervention
11 juillet 2019
-
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.
Commenter la réponse de JvDo