Buscar en rango aquellas celdas que sumen valor dado

Encontré estas pregunta y respuesta aquí en el foro que son por un problema casi idéntico a uno que yo tengo. La respuesta que dio el experto es muy buena, pero funciona sólo identificando dos celdas que cumplen la restricción, y no sé cómo modificar la macro para que no exista restricción en la cantidad de celdas que cumplan la condición. Es decir, yo no requiero forzar el resultado a dos celdas únicamente.
Gracias
Jose A.
---
Tengo lo siguiente
A1 10
A2 20
A3 30
A4 40
A5 50
Quiero que sume 50 solo con dos celdas
Y después las marque en negro
Esta pregunte es un suesto pueden haber 1000 celdas y quiero que sume a 55874
usando 745 celdas como combinación es el alma de la pregunta
puede ser cualquier sumatoria y yo pongo las caledas como limite de combinación a esa sumatoria
y que después las marque en negro
mandame la respuesta a
[email protected]
SI QUIERES ME AAGREGAS ATU MSN POR FAVOR AYUDAME QUE ESO ME TIENE LOCO .
11/09/2009
Experto
Hola, Eladio!
Disculpa si no te respondí antes, pero si leíste mi perfil, habrás notado que no me es posible responder durante los fines de semana.
Así que recién hoy pude ver tu mensaje y, ya ves, tienes tu respuesta.
Para resolver este tipo de problemas debes recurrir a programación.
Efectivamente, un procedimiento de Visual Basic for Aplications (VBA) es capaz de efectuar y mostrar los resultados.
Para ello necesitas ingresar los números a combinar en un rango vertical donde todas sus celdas deberán tener un valor. Es decir, la macro considerará sólo las celdas que encuentre con datos en ese
rango.
En otra celda, colocarás el valor objetivo a evaluar.
Deja un rango (de dos columnas) libre para que la macro muestre allí las combinaciones posibles.
En la macro que sigue a continuación, deberás indicar las direcciones de los rangos mencionados.
Para que funcione, activa el editor de Visual Basic (presiona Alt+F11), inserta un nuevo módulo ("Insertar", "Módulo") y pega el siguiente código:
Sub combNnum()
'Modificar referencias en hoja:
IniRango = "D4" 'Inicio de lista de numeros
ResObjet = "D23" 'Celda con resultado a buscar
IniLista = "N4" 'Inicio de lista de resultados posibles
'----------------------------
Dim FormOK As String
Set IniLista = Range(IniLista)
vCol = IniLista.Column
CuentaCasos = 0
'carga de valores a una matriz
Dim ListNum() As Variant
ReDim Preserve ListNum(0)
ListNum(0) = 0
Nro = 1
Set IniRango = Range(IniRango)
IniRango.Select
Do While Not IsEmpty(ActiveCell)
ReDim Preserve ListNum(Nro)
ListNum(Nro) = ActiveCell.Value
Nro = Nro + 1
ActiveCell.Offset(1).Select
Loop
IniLista.Select
IniLista.CurrentRegion.ClearContents
'Inicia ciclo de combinaciones
For NumAct = 1 To UBound(ListNum)
For NumSig = NumAct + 1 To UBound(ListNum)
RES = ListNum(NumAct) + ListNum(NumSig)
OdoMet = OdoMet + 1 'Cuenta iteracciones
'If RES > 0 Then
If RES = Range(ResObjet).Value Then
'En caso de que produzca el resultado consignado en ResObjet, arma fórmula correspondiente
CuentaCasos = CuentaCasos + 1
FormOK = ""
FormOK = " + " & ListNum(NumAct) & " + " & ListNum(NumSig)
'Selección de celda donde colocar el resultado
If IsEmpty(IniLista) Then
vRow = IniLista.Row
ElseIf IniLista.End(xlDown).Row > 50000 Then
vRow = IniLista.Offset(1).Row
Else
vRow = IniLista.End(xlDown).Offset(1).Row
End If
Cells(vRow, vCol).Value = Trim(FormOK)
Cells(vRow, vCol + 1).FormulaLocal = "=" & Trim(FormOK)
End If
Next NumSig
Next NumAct
'muestra Cantidad de casos encontrados
If CuentaCasos <> 0 Then
If IsEmpty(IniLista) Then
vRow = IniLista.Row
ElseIf IniLista.End(xlDown).Row > 50000 Then
vRow = IniLista.Offset(1).Row
Else
vRow = IniLista.End(xlDown).Offset(1).Row
End If
Cells(vRow, vCol).Value = CuentaCasos & " caso" & IIf(CuentaCasos > 1, "s", "")
MsgBox "Proceso terminado." & Chr(10) & "Encontrado: " & CuentaCasos & " combinaci" & IIf(CuentaCasos > 1, "ones", "ón") & Chr(10) & "Iteracciones: " & OdoMet, vbInformation, "RESULTADO:"
Else
MsgBox "No se encontró combinación para el resultado dado (" & Range(ResObjet).Value & ")", vbCritical, "SIN SOLUCION"
End If
Set IniLista = Nothing
Set IniRango = Nothing
End Sub
Tal como solicitaste esta macro calculará y mostrará todas aquellas combinaciones de dos elementos que sumen el valor indicado en la celda de objetivo.
Notarás que no marca en negro esos pares, porque puede haber más de una combinación, en particular si son muchos números. Por ello me pareció má interesante que los liste en algún rango de la hoja.
2

2 Respuestas

325 pts.

Hay un Excel 'add-in' :SumMatch que resuelve tu problema Fíjate aquí

47.950 pts. Ingeniero civil informático
Luego de cabecearme unas cuantas horas, no he podido llegar a un algoritmo que me de con la solución a tu interrogante.
El problema es el siguiente:
La solución planteada en el ejemplo que me muestras consideda la suma de dos números y si observas bien, te darás cuenta que tiene dos ciclos FOR (uno para cada número) lo que significa que, siguiendo este criterio, deberías utilizar tres FOR, para tres números, cuatro FOR para 4 y así sucesivamente, o sea, para cada caso tendrías que modificar el algoritmo.
Para evitarme lo anterior, intenté hacer algo recursivo y tras múltiples fracasos me acordé de uno concepto que me enseñaron en la Universidad, dicho concepto es la COMBINACIÓN. El número de combinaciones a analizar es muy variable dependiendo de la cantidad de elementos totales que tengamos y el tamaño de los grupos. Te lo explico con un ejemplo
Supongamos que tenemos 100 elementos y queremos saber si:
La suma de 2 de ellos es X:
Numero de combinaciones a evaluar -> 100C2 = 4.950
la suma de 4 de ellos es X:
Numero de combinaciones a evaluar -> 100C4 = 3.921.225
la suma de 8 de ellos es X:
Numero de combinaciones a evaluar -> 100C8 = 186.087.894.300
la suma de 16 de ellos es X:
Numero de combinaciones a evaluar -> 100C16 = 1.345.860.629.046.820.000
A lo que voy con esta explición, es que si pensamos en números que son relativamente pequeños, el tiempo que un computador se llevaría en procesarlo es de considerar (imagina lo que pasaría con números más grandes), por tanto no tiene sentido el hacer este algoritmo para grupos de tamaño indefinido.
La explicación anterior sigue siendo cierta, así que ten cuidado con los valores con que pruebas esta macro.
Creo que funciona para todos los casos posibles, siempre y cuando el cpmputador aguante.
Los valores están deben estar puestos en la columna DE desde la fila 4
Los resultados se entregan en la columna F desde la fila 1
El valor objetivo esta en la celda D23
La cantidad de números a considerar para la combinación se pone en D24
Me disculpas por no poner comentarios, que a esta hora lo único que quiero es descanso.
Misión cunplida ¡Gracias por el desafío!
Sub combNnum3()
    'Modificar referencias en hoja:
    IniRango = "D4" 'Inicio de lista de numeros
    IniLista = "F1" 'Inicio de lista de resultados posibles
    resObjet = "D23" 'Celda con resultado a buscar
    numValores = "D24" 'Número valores a sumar
    '----------------------------
    Set IniLista = Range(IniLista)
    vCol = IniLista.Column
    vFila = IniLista.Row
    'carga de valores a una matriz
    Dim ListNum()
    ReDim Preserve ListNum(0)
    ListNum(0) = 0
    Nro = 1
    Set IniRango = Range(IniRango)
    IniRango.Select
    Do While Not IsEmpty(ActiveCell)
        ReDim Preserve ListNum(Nro)
        ListNum(Nro) = ActiveCell.Value
        Nro = Nro + 1
        ActiveCell.Offset(1).Select
    Loop
    IniLista.Select
    IniLista.CurrentRegion.ClearContents
    'Inicia ciclo de combinaciones
    combinar ListNum, _
             Range(numValores).Value, _
             Range(resObjet).Value, _
             ActiveSheet, CLng(vFila), CInt(vCol)
    Set IniLista = Nothing
    Set IniRango = Nothing
End Sub
Sub combinar(lista, aSumar As Integer, _
            objetivo As Integer, hoja As Worksheet, _
            Optional filaIni As Long = 1, Optional colRes As Integer = 6)
    Dim lstAsum() As Integer
    Dim tamLista As Integer
    Dim suma As Integer
    Dim resp As String
    Dim itera As Double
    Dim pos As Integer
    tamLista = UBound(lista) + 1
    If tamLista > aSumar Then
        ReDim lstAsum(aSumar - 1)
        For i = 0 To aSumar - 1
            lstAsum(i) = i
        Next
        fin = False
        Do Until (fin)
            itera = itera + 1
            'hoja.Cells(itera,colRes+1).Value = lista(lstAsum(0) + 1) & "  " & _
                        lista(lstAsum(1) + 1) & "  " & _
                        lista(lstAsum(2) + 1)
            suma = 0
            resp = ""
            For i = 0 To UBound(lstAsum)
                suma = suma + lista(lstAsum(i) + 1)
                resp = resp & "+" & lista(lstAsum(i) + 1)
            Next
            If suma = objetivo Then
                hoja.Cells(filaIni, colRes).Value = resp
                filaIni = filaIni + 1
            End If
            pos = aSumar
            inc = aSumar
            ok = False
            Do Until (ok = True Or (pos - inc) >= aSumar Or fin = True)
                If (lstAsum(pos - inc) + 1 >= tamLista - inc) Then
                    If inc = aSumar Then
                        fin = True
                    Else
                        lstAsum(pos - inc - 1) = lstAsum(pos - inc - 1) + 1
                        Do Until (inc < 1)
                            lstAsum(pos - inc) = lstAsum(pos - inc - 1) + 1
                            inc = inc - 1
                        Loop
                    End If
                Else
                    If (pos - inc) >= aSumar - 1 Then
                        lstAsum(pos - inc) = lstAsum(pos - inc) + 1
                        ok = True
                    End If
                End If
                inc = inc - 1
            Loop
        Loop
        MsgBox "Nº Iteraciones: " & itera
    End If
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas