Combinatoria y cambiar la macro urgente gracias

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 .
Combinaciones (7/4/2003)
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:
Los datos en la hoja de cálculos
En a1 1000
En a2 2000
En a3 3000
En a4 4000
Esta macro solo me combina 2 elementos y yo quiero que me combine los elementos que yo le de cómo limite pueden ser 5 o 10 0 1000 elementos ¿ayudame a cambiar esta macro . Por que si pongo 8000 no me lo hace ya que solo combina 2 y debería combinar tres en en el fondo donde cambio la sintaxix para que combine todos los elementos necesarios para que haga bien la aplicación de ante mano muchas gracias
mándamela a [email protected]
Gracias expertos .
Esta es la macro
Sub combNnum()
'Modificar referencias en hoja:
IniRango = "A1" 'Inicio de lista de numeros
ResObjet = "A5" 'Celda con resultado a buscar
IniLista = "A10" '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 >= 50 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 >= 50 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(100) & "Encontrado: " & CuentaCasos & " combinaci" & IIf(CuentaCasos > 1, "ones", "ón") & Chr(100) & "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