Encontrar una cantidad resultado de sumar varias cantidades de un listado
Tengo un listado de 50 importes todos distintos entre si es decir .. Por ej. 254.32, 25,634 .231,236.21 .. Etc. Y necesito obtener una cantidad requerida ( por ej.28,758.94) de todos esos importes, ¿he tratado de usar solver pero a veces me funciona y otras (muchas) no me funciona pues no me da una cantidad aproximada existe algún método en excel mediante fórmulas o macros para poder hacerlo?
No me queda claro lo que quieres, si lo que quieres es buscar un valor entre los 50 tienes las funciones Vlookup, coincidir+indice, buscar, entre otras, si lo que quieres es buscar que combinación de importes que de una determinada suma el caso es muy diferente y solver no es la mejor opción en estos casos, más bien es jugar con las combinaciones hasta que una cumpla con la condición, la macro que te paso hace precisamente eso usando un algoritmo tipo ruleta, la G1 pones la suma que quieres buscar y en la columna C la macro te devolverá una aproximación al valor que buscas, la macro esta programada para hacer mil tiradas, no ocupas tantas solo lo deje para que este holgado.
y esta es la macro
Sub buscar_numeros()
Set funcion = WorksheetFunction
Set datos = Range("a1").CurrentRegion
Total = Range("g1")
With datos
f = .Rows.Count: c = .Columns.Count
mini = funcion.Min(.Columns(1))
.Sort key1:=Range(.Columns(1).Address), order1:=xlAscending
ReDim matriz(1 To 1000)
For i = 1 To 1000
aleat = WorksheetFunction.RandBetween(1, f)
numero = .Cells(aleat)
If i = 1 Then suma = numero
If i > 1 Then suma = suma + numero
matriz(i) = numero
If suma >= Total Then
Exit For
End If
Next i
otro:
sumar = WorksheetFunction.Sum(matriz)
If sumar > Total Then
matriz(i) = Empty
GoTo otro
Else
agregar = Total - sumar
If agregar > mini Then
fila = funcion.Match(agregar, .Columns(1), 1)
sumar = sumar + .Cells(fila)
matriz(i) = .Cells(fila)
GoTo otro
End If
End If
Set resultado = .Columns(c + 2).Resize(1000, 1)
End With
With resultado
.Clear
Range(.Address) = funcion.Transpose(matriz)
Set resultado = .CurrentRegion
.Rows(.Rows.Count + 1) = funcion.Sum(.Columns(1))
.Rows(.Rows.Count + 1).Font.Bold = True
End With
End Sub
Gracias por tu atención y tiempo, hice todo tal como propones pero no corre me aparece esto
" error en el metodo Sum del objeto WorksheetFunction
te agradecería me indicaras si estoy haciendo algo mal y que es
Gracias
Pues volví a correr la macro y le hice algunos modificaciones y me dio este resultado con los datos que hay en tu imagen
Sub buscar_numeros()
Set funcion = WorksheetFunction
Set datos = Range("a1").CurrentRegion
Total = Range("g1")
With datos
f = .Rows.Count: c = .Columns.Count
mini = funcion.Min(.Columns(1))
.Sort key1:=Range(.Columns(1).Address), order1:=xlAscending
ReDim matriz(1 To 1000)
For i = 1 To 1000
aleat = WorksheetFunction.RandBetween(1, f)
numero = .Cells(aleat)
If i = 1 Then suma = numero
If i > 1 Then suma = suma + numero
matriz(i) = numero
If suma >= Total Then
Exit For
End If
Next i
otro:
sumar = funcion.Sum(matriz)
If sumar > Total Then
matriz(i) = Empty
GoTo otro
Else
agregar = Total - sumar
If agregar > mini Then
fila = funcion.Match(agregar, .Columns(1), 1)
sumar = sumar + .Cells(fila)
matriz(i) = .Cells(fila)
End If
End If
Set resultado = .Columns(c + 2).Resize(1000, 1)
End With
With resultado
.Clear
Range(.Address) = funcion.Transpose(matriz)
Set resultado = .CurrentRegion
.Rows(.Rows.Count + 1) = funcion.Sum(.Columns(1))
.Rows(.Rows.Count + 1).Font.Bold = True
.Rows(.Rows.Count + 1).NumberFormat = "0.00"
Range("f1") = funcion.Sum(.Columns(1))
End With
End Sub
