Remise [Résolu/Fermé]

Signaler
Messages postés
34
Date d'inscription
mardi 12 juin 2018
Statut
Membre
Dernière intervention
26 juin 2020
-
Messages postés
11775
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
7 août 2020
-
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

Messages postés
11775
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
7 août 2020
674
bonjour, que veux-tu calculer?
Messages postés
4854
Date d'inscription
mardi 19 janvier 2010
Statut
Contributeur
Dernière intervention
21 juillet 2020
1 042
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...
Messages postés
34
Date d'inscription
mardi 12 juin 2018
Statut
Membre
Dernière intervention
26 juin 2020

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
Messages postés
4854
Date d'inscription
mardi 19 janvier 2010
Statut
Contributeur
Dernière intervention
21 juillet 2020
1 042 >
Messages postés
34
Date d'inscription
mardi 12 juin 2018
Statut
Membre
Dernière intervention
26 juin 2020

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.
Messages postés
34
Date d'inscription
mardi 12 juin 2018
Statut
Membre
Dernière intervention
26 juin 2020

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.
Messages postés
11775
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
7 août 2020
674 >
Messages postés
34
Date d'inscription
mardi 12 juin 2018
Statut
Membre
Dernière intervention
26 juin 2020

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?
Messages postés
11775
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
7 août 2020
674
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

Messages postés
11775
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
7 août 2020
674
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
Messages postés
34
Date d'inscription
mardi 12 juin 2018
Statut
Membre
Dernière intervention
26 juin 2020

merci beaucoup
ça fonctionne très bien
bonne soirée
Messages postés
11775
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
7 août 2020
674 >
Messages postés
34
Date d'inscription
mardi 12 juin 2018
Statut
Membre
Dernière intervention
26 juin 2020

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
Messages postés
1925
Date d'inscription
mercredi 27 juillet 2005
Statut
Membre
Dernière intervention
7 juillet 2020
793
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
Messages postés
34
Date d'inscription
mardi 12 juin 2018
Statut
Membre
Dernière intervention
26 juin 2020

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.