Cantidad optima caja para disponer dinero.
Trabajo en una tienda (casa de empeño) donde hay varias cajas, tenemos un problema, siempre nos quedamos sin cambio o bien sin billetes, es por ello que acusó a ustedes a ver si me pueden ayudar a configurar una función en Excel, formula, macro o lo que sirva para lo siguiente.
Si en mi caja tengo las siguientes denominaciones de billetes.
Columna A. Columna B
Denominación #Piezas
1000. 20
500. 15
200. 21
100. 44
50. 34
20. 10
Si quiero darle a una persona 1000 pesos, cual es la cantidad ideal que debo de darle por denominación para que siempre este equilibrada la caja y cuente en todo momento con piezas de todas las denominaciones, Ej, si quiero 1000 puedo entregar una pieza de 1000 o 2 de quinientos, o 1 de 500 2 de 200 y 1 de 100.
Entonces yo al colocar en la celda d5 el monto a entregar al cliente, el archivo de Excel me diga en la columna c cuantas piezas de cada denominación debo de entregarle a mi cliente.
1 respuesta
Te anexo las macros.
Sub Visualizar()
'Por.Dante Amor
desglosar False
End Sub
Sub Actualizar()
'Por.Dante Amor
desglosar True
End Sub
Sub desglosar(actual)
'Por.Dante Amor
Dim b As New Collection
v = [D2]
dec = v - Int(v)
dec = Right(Format(dec, ".00"), 2)
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
b.Add Cells(i, "A")
Cells(i, "C") = ""
Next
'
'Desglosar
i = 2
For Each d In b
sacar = False
If v / d >= 1 Then
If Int(v / d) = 1 Then
s = s & "uno" & " de $" & d & ", "
If Cells(i, "B") >= 1 Then
Cells(i, "C") = 1
sacar = True
End If
Else
s = s & Int(v) / d & " de $" & d & ", "
If Cells(i, "B") >= Int(v / d) Then
Cells(i, "C") = Int(v / d)
sacar = True
End If
End If
If sacar Then
v = v - Int(v / d) * d
If actual Then
Cells(i, "B") = Cells(i, "B") - Cells(i, "C")
End If
End If
End If
i = i + 1
Next
If v > 0 Then
MsgBox "No hay suficiente dinero", vbExclamation
End If
End SubPon todas las macro en un módulo.
Pon todas las denominaciones que manejes en la columna A, no importa si son billetes o monedas.
Asigna la macro "Visualizar" al botón Visualizar, presiona el botón para que puedas ver un previo el desglose de la distribución.
Asigna la macro "Actualizar" al botón Actualizar para que la cantidad de billetes o monedas sean actualizadas, es decir, se reste la cantidad que vayas a sacar.
Te anexo mi archivo para que realices pruebas.
https://www.dropbox.com/s/lwctyr2vji08eup/billetes4.xlsm?dl=0
S a l u d o s . D a n t e A m o r
Recuerda valorar la respuesta.
Dante es justo lo que quiero, solo una duda, ¿es posible agregarle un A condición? Mira el ejemplo
denominacion , # de piezas
1000, 20
500, 20
200, 20,
Si solicitó 2000 pesos, el sistema me daría 2 de 1000 quedando 18 piezas, ¿si la siguiente persona le tengo que dar otros 2000 Que se haga el cálculo sobre la denominación(es) que tiene más piezas es decir si la siguiente operación es para entregar otros 2000 entregar 4 de 500?
Te anexo las macros actualizadas, reemplaza estas macros por las anteriores.
Lo que va a realizar la macro es buscar la siguiente denominación con más cantidad, si le alcanza toma ese dinero, si no le alcanza entonces sigue con el procedimiento normal. Te comento que solamente va a revisar una revisión de la denominación con más cantidad, por ejemplo: si tienes esto:
A B
1 1000 18
2 500 20
3 200 20
4 50 22
Y quieres sacar 2,000, entonces la denominación de $50, es el que tiene la mayor cantidad, pero no alcanza para 2,000; por lo tanto la macro tomaría 2 de 1,000.
Entiendo que quisieras que la macro buscara todavía algo más optimo, pero sería una macro todavía más complicada.
Sigue las Instrucciones para ejecutar la macro
- Abre tu archivo de excel
- Para abrir Vba-macros y poder cambiar la macro, Presiona Alt + F11
- En el panel del lado derecho reemplaza la nueva macro.
S a l u d o s . D a n t e A m o r
Recuerda valorar la respuesta.
Hola Dante, no veo los archivos adjuntos o bien el código, ¿me ayudas por favor?
Perdona, no se pegó la macro, ahí va:
Sub Visualizar()
'Por.Dante Amor
desglosar False
End Sub
'
Sub Actualizar()
'Por.Dante Amor
desglosar True
End Sub
'
Sub desglosar(actual)
'Por.Dante Amor
Dim b As New Collection
v = [D2]
dec = v - Int(v)
dec = Right(Format(dec, ".00"), 2)
n = 1
u = Range("A" & Rows.Count).End(xlUp).Row
If u = 1 Then
MsgBox "No hay Denominaciones", vbCritical
Exit Sub
End If
'
For i = 2 To u
b.Add Cells(i, "A")
Cells(i, "C") = ""
Next
'
'Desglosar
i = 2
For k = 1 To b.Count
sacar = False
If v / b(k) >= 1 Then
fila = Application.Match(Application.Max(Range("B1:B" & u)), Range("B1:B" & u), 0)
If Cells(fila, "B") >= Int(v / b(fila - 1)) And Int(v / b(fila - 1)) >= 1 Then
Cells(fila, "C") = Int(v / b(fila - 1))
n = fila - 1
sacar = True
ElseIf Cells(i, "B") >= Int(v / b(k)) Then
Cells(i, "C") = Int(v / b(k))
n = k
sacar = True
End If
If sacar Then
v = v - Int(v / b(n)) * b(n)
If actual Then
Cells(i, "B") = Cells(i, "B") - Cells(i, "C")
End If
End If
End If
i = i + 1
Next
If v > 0 Then
MsgBox "No hay suficiente dinero", vbExclamation
End If
End Sub
