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?

1 Respuesta

Respuesta
2

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

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas