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.
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 Respuestas
Respuesta de Isaac Reyes
1
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.
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
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