Equilibrage de caisse

Le 08/10/2019 à 12:39

Bonjour à tous,

Voici la problématique que je rencontre, je pense qu'il s'agit d'un casse tête à la fois logique, mathématique et Excelien,

Voici la situation initiale, j'ai plusieurs caisses de monnaie contenant toutes des pièces et des billets,

Les caisses n'ont pas le même nombre de pièces ni de billets,

J'aimerai savoir si vous pensez qu'il est possible de trouver un moyen d''équilibrer' les caisses à la fin d'une journée par exemple.

Ainsi avoir chaque caisse avec la même somme d'argent, en fonction du nombre de pièces et de billets dans chaque caisse initialement.

Actuellement j'arrive avec des fonctions MOD à répartir le nombre de pièces et de billets dans chaque caisse, mais je n'arrive pas à faire que chaque caisse soit à la même somme.

Vous trouverez en pièce jointe les tableaux que j'utilise actuellement, car cela sera plus parlant,

(A gauche les caisses initiales)

Si jamais vous avez une idée je suis preneur,

Merci à tous et beaucoup,

Ben

53classeur1.xlsx (20.92 Ko)
Le 08/10/2019 à 16:28

Salut BenCD,

j'imagine que, pour la jouer fine, style coupeur de cheveux en quatre, tu veux aussi équilibrer le nombre de billets et de pièces différents par caisse?

A+

Le 08/10/2019 à 16:44

Bonjour,

Un somme.si, divisé par la valeur faciale te donne le nb de pièces d'un type dans toutes les caisses, tu le divise ensuite par le nb de caisse ?

Non ?

A+

Le 08/10/2019 à 17:31

Bonjour, salut curulis59, salut magnan

Je te propose d'utiliser le Solveur Excel (si besoin : cours Solveur) :

29testsolveur.xlsx (14.77 Ko)

Je t'avoue que j'ai eu un peu de mal à le paramétrer car le Solveur a fait planter plusieurs fois le classeur. J'ai essayé d'optimiser au mieux la résolution, mais il faudra quand même être patient avant d'obtenir un résultat...

Le 08/10/2019 à 17:51
magnan a écrit :

Bonjour,

Un somme.si, divisé par la valeur faciale te donne le nb de pièces d'un type dans toutes les caisses, tu le divise ensuite par le nb de caisse ?

Non ?

Tu es allé trop vite pour moi ....

A+

///

curulis57 a écrit :

Salut BenCD,

j'imagine que, pour la jouer fine, style coupeur de cheveux en quatre, tu veux aussi équilibrer le nombre de billets et de pièces différents par caisse?

Ahah même pas, ce n’est pas le but ici, l’idée c’est ‘uniquement’ de pouvoir avec les caisses initiales faire une répartition équitable au maximum.

Que toutes les caisses aient la même somme et éviter qu’une caisse ai 100 pièces de 1€ et une autre 2 billets de 50€, mais plutôt 50 pièces et 1 billet chacun.

A+

///

Pedro22 a écrit :

Bonjour, salut curulis59, salut magnan

Je te propose d'utiliser le Solveur Excel (si besoin : cours Solveur) :

TestSolveur.xlsx

Je t'avoue que j'ai eu un peu de mal à le paramétrer car le Solveur a fait planter plusieurs fois le classeur. J'ai essayé d'optimiser au mieux la résolution, mais il faudra quand même être patient avant d'obtenir un résultat...

Merci je regarde cela

Le 08/10/2019 à 18:30

C'est bien ce que je voulais dire... Je regarde ça dès que je peux...

Le 08/10/2019 à 18:33

Re,

En fichier joint une proposition.

Avec des formules et décomposées.

Tu pourras les combiner.

pas besoin de formule somme.si ou autre.

Si j'ai bien compris ton pb.

A+

35proposition.xlsx (23.81 Ko)
Le 08/10/2019 à 18:53
magnan a écrit :

Re,

En fichier joint une proposition.

Avec des formules et décomposées.

Tu pourras les combiner.

pas besoin de formule somme.si ou autre.

Si j'ai bien compris ton pb.

A+

Un immense merci pour ton temps et ton aide,

Je ne suis pas certain de tout comprendre,

Dans le tableau de droite, les caisses n'ont pas la même somme malheureusement.

J'aimerai si c'est possible, qu'avec le tableau de gauche savoir combien j'ai en monnaie dans chaque caisse, et dans le tableau de droite savoir combien je dois mettre de pièces et billet de chaque pour que toutes les caisses soit à la même valeur, tout en équilibrant au mieux. Même si c'est pas possible à 100%. Toutes les caisses ne seront pas identiques.

Le 08/10/2019 à 19:01

re,

a gauche l'origine.

en dessous il y a le nb de piéces pour chaque caisse.

pour que toutes soient équivalentes il y aura des restes.

ensuite chaque caisse recevra le nb déterminé en dessous du tableau d'origine.

A droite je pensais que c'était les billets... alors ... tout faux...

a+

Le 08/10/2019 à 19:08
magnan a écrit :

re,

a gauche l'origine.

en dessous il y a le nb de piéces pour chaque caisse.

pour que toutes soient équivalentes il y aura des restes.

ensuite chaque caisse recevra le nb déterminé en dessous du tableau d'origine.

A droite je pensais que c'était les billets... alors ... tout faux...

a+

Ah je comprends

Voila le truc c'est pas qu'il y ai forcément des "équivalences" sur le nombre de pièce de 1€ dans toutes les caisses, si une caisse à un billet de 5 et une autre 5pièces de 1€ c'est pas grave, je cherche à 'équilibrer' au maximum.

Le 08/10/2019 à 19:10

Re,

Effectivement tu veux tout redistribuer.

Je vais regarder pour qu'il n'y ait plus rien ou le minimum.

A+

Le 08/10/2019 à 20:16
magnan a écrit :

Re,

Effectivement tu veux tout redistribuer.

Je vais regarder pour qu'il n'y ait plus rien ou le minimum.

A+

Merci

Le 09/10/2019 à 01:03

Salut BenCD,

Salut l'équipe,

une solution en VBA...

Tu remplis le tableau de gauche : chaque changement provoque le recalcul du tableau de droite.

Private Sub Worksheet_Change(ByVal Target As Range)
'
iRowB = Range("B" & Rows.Count).End(xlUp).Row
If Not Intersect(Target, Range("C3:I" & iRowB - 1)) Is Nothing Then
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Range("M3:S" & iRowB - 1).ClearContents
    '
    For x = 7 To 1 Step -1
        iNb = Cells(iRowB, 2 + x)
        If iNb > 0 Then
            iMax = WorksheetFunction.Max(Range("T3:T" & iRowB - 1))
            iMin = WorksheetFunction.Min(Range("T3:T" & iRowB - 1))
            iStep = IIf(iMax > iMin, 1, 2)
            iMore = 0
            iRow = 3
        End If
        Do While iNb > 0
            If (iStep = 1 And Cells(iRow, 20) < iMax) Or iStep = 2 Then
                Cells(iRow, 12 + x) = Cells(iRow, 12 + x) + 1
                If iStep = 1 And Cells(iRow, 20) < iMax Then iMore = 1
                iNb = iNb - 1
            End If
            iRow = iRow + 1
            If iRow > iRowB - 1 Then
                iStep = IIf(iMore = 1, 1, 2)
                iMore = 0
                iRow = 3
            End If
        Loop
    Next
    '
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End If
'
End Sub

A+

10bencd.xlsm (28.27 Ko)
Le 09/10/2019 à 07:36

Bonjour,

As tu essayé en posant le pb sur un forum de matheux ?

Par exemple : http://forum.mathematex.net

A+

Le 09/10/2019 à 13:35
curulis57 a écrit :

Salut BenCD,

Salut l'équipe,

une solution en VBA...

Tu remplis le tableau de gauche : chaque changement provoque le recalcul du tableau de droite.

Private Sub Worksheet_Change(ByVal Target As Range)
'
iRowB = Range("B" & Rows.Count).End(xlUp).Row
If Not Intersect(Target, Range("C3:I" & iRowB - 1)) Is Nothing Then
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Range("M3:S" & iRowB - 1).ClearContents
    '
    For x = 7 To 1 Step -1
        iNb = Cells(iRowB, 2 + x)
        If iNb > 0 Then
            iMax = WorksheetFunction.Max(Range("T3:T" & iRowB - 1))
            iMin = WorksheetFunction.Min(Range("T3:T" & iRowB - 1))
            iStep = IIf(iMax > iMin, 1, 2)
            iMore = 0
            iRow = 3
        End If
        Do While iNb > 0
            If (iStep = 1 And Cells(iRow, 20) < iMax) Or iStep = 2 Then
                Cells(iRow, 12 + x) = Cells(iRow, 12 + x) + 1
                If iStep = 1 And Cells(iRow, 20) < iMax Then iMore = 1
                iNb = iNb - 1
            End If
            iRow = iRow + 1
            If iRow > iRowB - 1 Then
                iStep = IIf(iMore = 1, 1, 2)
                iMore = 0
                iRow = 3
            End If
        Loop
    Next
    '
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End If
'
End Sub

A+

Ça marche super!!!

Merci pour tout!!!

Le 15/10/2019 à 09:05
curulis57 a écrit :

Salut BenCD,

Salut l'équipe,

une solution en VBA...

Tu remplis le tableau de gauche : chaque changement provoque le recalcul du tableau de droite.

Private Sub Worksheet_Change(ByVal Target As Range)
'
iRowB = Range("B" & Rows.Count).End(xlUp).Row
If Not Intersect(Target, Range("C3:I" & iRowB - 1)) Is Nothing Then
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Range("M3:S" & iRowB - 1).ClearContents
    '
    For x = 7 To 1 Step -1
        iNb = Cells(iRowB, 2 + x)
        If iNb > 0 Then
            iMax = WorksheetFunction.Max(Range("T3:T" & iRowB - 1))
            iMin = WorksheetFunction.Min(Range("T3:T" & iRowB - 1))
            iStep = IIf(iMax > iMin, 1, 2)
            iMore = 0
            iRow = 3
        End If
        Do While iNb > 0
            If (iStep = 1 And Cells(iRow, 20) < iMax) Or iStep = 2 Then
                Cells(iRow, 12 + x) = Cells(iRow, 12 + x) + 1
                If iStep = 1 And Cells(iRow, 20) < iMax Then iMore = 1
                iNb = iNb - 1
            End If
            iRow = iRow + 1
            If iRow > iRowB - 1 Then
                iStep = IIf(iMore = 1, 1, 2)
                iMore = 0
                iRow = 3
            End If
        Loop
    Next
    '
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End If
'
End Sub

A+

Hello à tous,

Je me permets de faire une nouvelle (petite) demande concernant ce sujet,

La solution que m'a apporté @Curulis57 est top,

Néanmoins j'aimerai savoir s'il était possible de 'modifier' quelque chose,

Actuellement, les 'nouvelles' caisses se génèrent automatiquement et de façon 'égalent', est il possible d'imaginer une solution ou je décide du montant de chaque caisse (dans la dernière colonne du tableau de droite),

Ainsi on aurait dans le tableau de gauche le nombre de billets et de pièces de chaque caisse,

Dans le tableau de droite le nombre de billets et de pièces de chaque caisses après 'équilibrage' en fonction du montant que l'on désire dans chaque caisse,

D'avance merci infiniment,

BenCD

3bencd-1.xlsm (28.27 Ko)
Le 15/10/2019 à 13:59

Salut BenCD,

voilà...

Petites manipulations de fonctionnement :

  • une colonne supplémentaire ['U] est installée à droite du tableau de calcul où tu peux régler les sommes désirées par caisse ;
  • les changements dans le tableau de gauche ou dans cette colonne ['U] provoque un calcul de répartition dans cette même colonne ['U] en fonction des critères suivants ;
  • un double-clic dans une cellule en ['U] correspondant à une caisse signale au calcul de répartition que cette somme est bloquée en affichant cette somme en GRAS ;
  • un clic-droit sur une somme en GRAS débloque cette somme ;
  • après le calcul de répartition, le calcul de caisses s'exécute selon cette répartition.

Il est fort possible que, du fait de ces restrictions, les monnaies ne soient plus aussi bien réparties entre caisses, principalement les 1,2 et 5.

Public Sub CalculCaisses()
'
iRowB = Range("B" & Rows.Count).End(xlUp).Row
Range("M3:S" & iRowB - 1).ClearContents
'
For x = 7 To 1 Step -1
    iNb = Cells(iRowB, 2 + x)                                       'Nb de billets ou monnaie
    If iNb > 0 Then
        iMax = WorksheetFunction.Max(Range("T3:T" & iRowB - 1))     'total distribué max
        iMin = WorksheetFunction.Min(Range("T3:T" & iRowB - 1))     'total distribué min
        iStep = IIf(iMax > iMin, 1, 2)                              'type de distribution 1 = d'abord combler le retard des caisses en MIN  /  2 = linéaire
        iMore = 0                                                   'NEXT iStep=1 si retard pas encore comblé
        iRow = 3
    End If
    Do While iNb > 0
        If (iStep = 1 And Cells(iRow, 20) < iMax And iMax < Cells(iRow, 21)) Or iStep = 2 And Cells(iRow, 20) < Cells(iRow, 21) Then
            If Cells(iRow, 12 + x) + Cells(2, 12 + x) <= Cells(iRow, 21) Then
                Cells(iRow, 12 + x) = Cells(iRow, 12 + x) + 1
                iNb = iNb - 1
            End If
            If iStep = 1 And Cells(iRow, 20) < iMax And iMax < Cells(iRow, 21) Then iMore = 1
        End If
        iRow = iRow + 1
        If iRow > iRowB - 1 Then
            iStep = IIf(iMore = 1, 1, 2)
            iMore = 0
            iRow = 3
        End If
    Loop
Next
'
End Sub

A+

19bencd.xlsm (28.35 Ko)
Le 15/10/2019 à 14:50
curulis57 a écrit :

Salut BenCD,

voilà...

Petites manipulations de fonctionnement :

  • une colonne supplémentaire ['U] est installée à droite du tableau de calcul où tu peux régler les sommes désirées par caisse ;
  • les changements dans le tableau de gauche ou dans cette colonne ['U] provoque un calcul de répartition dans cette même colonne ['U] en fonction des critères suivants ;
  • un double-clic dans une cellule en ['U] correspondant à une caisse signale au calcul de répartition que cette somme est bloquée en affichant cette somme en GRAS ;
  • un clic-droit sur une somme en GRAS débloque cette somme ;
  • après le calcul de répartition, le calcul de caisses s'exécute selon cette répartition.

Il est fort possible que, du fait de ces restrictions, les monnaies ne soient plus aussi bien réparties entre caisses, principalement les 1,2 et 5.

Public Sub CalculCaisses()
'
iRowB = Range("B" & Rows.Count).End(xlUp).Row
Range("M3:S" & iRowB - 1).ClearContents
'
For x = 7 To 1 Step -1
    iNb = Cells(iRowB, 2 + x)                                       'Nb de billets ou monnaie
    If iNb > 0 Then
        iMax = WorksheetFunction.Max(Range("T3:T" & iRowB - 1))     'total distribué max
        iMin = WorksheetFunction.Min(Range("T3:T" & iRowB - 1))     'total distribué min
        iStep = IIf(iMax > iMin, 1, 2)                              'type de distribution 1 = d'abord combler le retard des caisses en MIN  /  2 = linéaire
        iMore = 0                                                   'NEXT iStep=1 si retard pas encore comblé
        iRow = 3
    End If
    Do While iNb > 0
        If (iStep = 1 And Cells(iRow, 20) < iMax And iMax < Cells(iRow, 21)) Or iStep = 2 And Cells(iRow, 20) < Cells(iRow, 21) Then
            If Cells(iRow, 12 + x) + Cells(2, 12 + x) <= Cells(iRow, 21) Then
                Cells(iRow, 12 + x) = Cells(iRow, 12 + x) + 1
                iNb = iNb - 1
            End If
            If iStep = 1 And Cells(iRow, 20) < iMax And iMax < Cells(iRow, 21) Then iMore = 1
        End If
        iRow = iRow + 1
        If iRow > iRowB - 1 Then
            iStep = IIf(iMore = 1, 1, 2)
            iMore = 0
            iRow = 3
        End If
    Loop
Next
'
End Sub

A+

C'est parfait !!!

Mille mercis !!

Rechercher des sujets similaires à "equilibrage caisse"