Remise

Résolu/Fermé

94michel Messages postés 38 Date d'inscription mardi 12 juin 2018 Statut Membre Dernière intervention 10 septembre 2020 - 11 juil. 2019 à 13:18
yg_be Messages postés 22698 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 18 avril 2024 - 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/

A voir également:

Remise
Remise a zero pc - Guide
Remise à zéro iphone - Guide
Remise a zero chromecast - Guide
Remise a zero kidicom max ✓ - Forum Téléphones & tablettes Android
Logiciel remise à zéro compteur imprimante epson gratuit - Forum Imprimante

3 réponses

Réponse 1 / 3

yg_be Messages postés 22698 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 18 avril 2024 1 471
11 juil. 2019 à 13:58

bonjour, que veux-tu calculer?

94michel Messages postés 38 Date d'inscription mardi 12 juin 2018 Statut Membre Dernière intervention 10 septembre 2020
11 juil. 2019 à 14:06

bonjour,
une remise de 4637,60€ avec un tableau de plusieurs montant en sélectionnant automatiquement les montants de la somme en remise.
merci

yg_be Messages postés 22698 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 18 avril 2024 1 471 > 94michel Messages postés 38 Date d'inscription mardi 12 juin 2018 Statut Membre Dernière intervention 10 septembre 2020
11 juil. 2019 à 14:43

que faut-il avoir comme résultat dans quelle cellule?

94michel Messages postés 38 Date d'inscription mardi 12 juin 2018 Statut Membre Dernière intervention 10 septembre 2020
11 juil. 2019 à 15:05

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

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".

Ghörgh Messages postés 4886 Date d'inscription mardi 19 janvier 2010 Statut Contributeur Dernière intervention 4 avril 2023 1 241
11 juil. 2019 à 15:13

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

Réponse 2 / 3

yg_be Messages postés 22698 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 18 avril 2024 1 471
11 juil. 2019 à 18:45

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 22698 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 18 avril 2024 1 471
11 juil. 2019 à 20:27

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 38 Date d'inscription mardi 12 juin 2018 Statut Membre Dernière intervention 10 septembre 2020
11 juil. 2019 à 21:03

merci beaucoup
ça fonctionne très bien
bonne soirée

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

Réponse 3 / 3

JvDo Messages postés 1978 Date d'inscription mercredi 27 juillet 2005 Statut Membre Dernière intervention 28 septembre 2020 856
11 juil. 2019 à 20:47

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 38 Date d'inscription mardi 12 juin 2018 Statut Membre Dernière intervention 10 septembre 2020
11 juil. 2019 à 21:07

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.

Discussions similaires

remise a zero compteur epson

Vente en main propre sur leboncoin

Recherche musique pour remise de médaille

formule excel avec une remise en %

Paiement Leboncoin

Discussions similaires

Newsletters