Ayuda no se programar

[Martha Canul]

Hola a Todos y buen dia.

Espero y puedan apoyarme con mi tema de antemano muchas Gracias

Tengo un codigo de macro que me sale error, y quisiera que alguien me ayudara, Explico que es lo que debe de hacer esa macro.

Tengo numeros distintos en la columna A y un importe a buscar en la columna C2

lo que requiero es que en la columna B me señale con una "x" los importes exactos que sumen  la celda que se encuentra en la Columna "C2"

Anexo Archivo .

Libro1.xlsm

[Haplox]

Qué tal @Martha Canul,

Lo que pides es realmente complejo, pues un problema de combinatoria, cuyas combinaciones crecen exponecialmente con el número de celdas a evaluar (el valor es (2^nº de celdas)-1).

Por fortuna tienes el complemento Solver de Excel, que incluso en tu caso tardara un ratito en encontrar la solución.

Hace tiempo tuve un tipo de problema de este tipo y me topé con la ´pagina que te dejo, donde resuelven exactamente tu problema:

http://www.jrgc.es/trucos001.htm

 

[Israel Cassales]

Hola, yo hice una tarea hace un tiempo que hace eso. Sería modificar los rangos, para tu solicitud quedaría algo así:

Sub MarcarValores()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Hoja1")
    
    Dim targetSum As Double
    targetSum = ws.Range("C2").Value
    
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    Dim values As Variant
    values = ws.Range("A2:A" & lastRow).Value
    
    Dim foundCombination As Boolean
    foundCombination = FindCombination(values, targetSum, 1, ws)
    
    If Not foundCombination Then
        MsgBox "No hay valores que sumen esa cantidad"
    End If
End Sub

Function FindCombination(values As Variant, targetSum As Double, startIndex As Long, ws As Worksheet) As Boolean
    If targetSum = 0 Then
        FindCombination = True
        Exit Function
    End If
    
    If startIndex > UBound(values) Then
        FindCombination = False
        Exit Function
    End If
    
    For i = startIndex To UBound(values)
        If values(i, 1) <= targetSum Then
            ws.Range("B" & i + 1).Value = "X"
            If FindCombination(values, targetSum - values(i, 1), i + 1, ws) Then
                FindCombination = True
                Exit Function
            Else
                ws.Range("B" & i + 1).Value = ""
            End If
        End If
    Next i
    
    FindCombination = False
End Function

Sólo tendría que insertar un módulo, pegarla y funcionaria algo así:

En resumen es usar un bucle para recorrer el rango de valores en la columna A y verificar si hay combinaciones de valores que sumen la cantidad escrita en C2. Si se encuentra una combinación, te marca las celdas correspondientes en la columna B con la “X” y si no se encuentra ninguna combinación, pues mostrar un mensaje indicando que no hay valores que sumen esa cantidad.

Saludines

[Israel Cassales]

Había subido tu archivo pero rectifique, (siempre me pasa, lo lamento) así que le agregue una limpia de las X al ejecutar, porque sino se van quedando ahí, se ven feo y se confunden con el resultado.

Ahora sí, me parece que cumple con la ayuda que solicitas. Espero te sea útil y quedamos atentos a tus comentarios, si necesitas algo más con confianza abre el tema que aquí en el foro hay compañeros con gran experiencia y códigos sobresalientes.

Si crees que cumple para ser marcada como solución ayudaría mucho en el orden de los temas el que lo marques; en caso contrario no te preocupes, seguro se sumarán más aportes. Toma provecho, les podemos aprender mucho.

Saludines_2

 

Libro1_propuesta solucion.xlsm