Function DesgloseMonetarioRango(Rango As Range) As Variant
Dim MonedasBilletes As Variant
MonedasBilletes = Array(500, 200, 100, 50, 20, 10, 5, 2, 1, 0.5, 0.2, 0.1, 0.05, 0.02, 0.01)
Dim DesgloseTotal As Object
Set DesgloseTotal = CreateObject("Scripting.Dictionary") Dim Celda As Range
Dim Cantidad As Double
Dim i As Integer
Dim CantidadRestante As Double
Dim CantidadDeMonedas As Integer
Dim Resultado As Variant
Dim Fila As Integer
' Inicializar el diccionario de desglose total con todas las denominaciones en cero
For i = LBound(MonedasBilletes) To UBound(MonedasBilletes)
DesgloseTotal(MonedasBilletes(i)) = 0
Next i
' Iterar a través de cada celda en el rango proporcionado
For Each Celda In Rango
If IsNumeric(Celda.Value) Then
Cantidad = CDbl(Celda.Value)
CantidadRestante = Cantidad
' Calcular el desglose para la cantidad actual y sumarlo al desglose total
For i = LBound(MonedasBilletes) To UBound(MonedasBilletes)
If CantidadRestante >= MonedasBilletes(i) Then
CantidadDeMonedas = Int(CantidadRestante / MonedasBilletes(i))
DesgloseTotal(MonedasBilletes(i)) = DesgloseTotal(MonedasBilletes(i)) + CantidadDeMonedas
CantidadRestante = CantidadRestante - (CantidadDeMonedas * MonedasBilletes(i))
End If
Next i
End If
Next Celda
' Crear la matriz de resultados con títulos y cantidades
ReDim Resultado(1 To DesgloseTotal.Count, 1 To 2)
Fila = 1
For i = LBound(MonedasBilletes) To UBound(MonedasBilletes)
Resultado(Fila, 1) = MonedasBilletes(i)
Resultado(Fila, 2) = DesgloseTotal(MonedasBilletes(i))
Fila = Fila + 1
Next i
DesgloseMonetarioRango = Resultado
End Function
Crear cuenta
Comentarios sobre la versión: 1.0 (0)
No hay comentarios