Macro para realizar busqueda en otra hoja,copiar una celda de la fila encontrada si cumple condicion

Tengo 3 hojas.

La hoja 1 tenemos producto, destino, bodega y cantidad

buscamos en la hoja 3 el distino  de la hoja 1

Si esa bodega encontrada tiene stock(el stock se encuentra en la hoja 2) para cumplir lo pedido copiamos a la hoja 1 la bodega de la hoja 3. Pasamos a la siguiente fila de la hoja 1 y se repite el proceso hasta la ultima fila de la hoja 1. Si el stock no es suficiente, pasamos a la siguiente bodega del destino buscado en la hoja 3, siempre habrá 5 bodegas para cada destino(estas estan ordenadas de menos distancia a mayor distancia del destino) en la hoja 3. En la hoja 2 puede que no esté la bodega encontrada en la hoja 3, asi que se debe pasar a la siguiente bodega de la hoja 3.

Intente hacer esto con ciclos for anidados pero la verdad es que no me manejo en el lenguaje y no me funcionó nada.

Ojala me pudieran ayudar

Respuesta
2

No me quedan claros tus ejemplos que pusiste en las imágenes, ya que tanto en productos como en bodegas repites las mismas letras. Además para armar la macro o las fórmulas sería más fácil si hubieses puesto las filas y las columnas en las imágenes.

Me puedes enviar tu archivo con ejemplos reales, me marcas con diferentes color un par de ejemplos para entender cuál es el resultado que esperas.

Por lo que entiendo en la hoja 1 hay que poner el resultado, entonces deja la hoja1 tal cual y en la hoja4 me pones el resultado que esperas.

Gracias por tu buena disposición, ya he enviado el archivo a tu correo, quedo atento a cualquier información.

Saludos cordiales

Esta es la macro para realizar búsqueda.

Sub BuscarBodegaSugerida()
'Por.Dante Amor
    Set h1 = Sheets("Hoja1")
    Set h2 = Sheets("Hoja2")
    Set h3 = Sheets("Hoja3")
    Set h4 = Sheets("Temp")
    Application.ScreenUpdating = False
    u1 = h1.Range("A" & Rows.Count).End(xlUp).Row
    u3 = h3.Range("A" & Rows.Count).End(xlUp).Row
    h1.Range("D2:D" & u1).ClearContents
    For i = 2 To u1
        h4.Cells.Clear
        h3.Range("A1:C1").AutoFilter
        h3.ListObjects("Tabla_Consulta_desde_SQL_SERVIDOR").Range.AutoFilter _
            Field:=2, Criteria1:=h1.Cells(i, "C")
        h3.Range("A1:A" & u3).Copy
        h4.Range("B1").PasteSpecial Paste:=xlPasteValues
        u4 = h4.Range("B" & Rows.Count).End(xlUp).Row
        h4.Range("A1") = h2.Range("A1")
        h4.Range("B1") = h2.Range("B1")
        h4.Range("A2:A" & u4) = h1.Cells(i, "A")
        u4 = h4.Range("B" & Rows.Count).End(xlUp).Row
        h2.Columns("A:C").AdvancedFilter _
            Action:=xlFilterCopy, _
            CriteriaRange:=h4.Range("A1:B" & u4), _
            CopyToRange:=h4.Range("F1"), Unique:=False
        existe = False
        For j = 2 To u4
            Set r = h4.Columns("G")
            Set b = r.Find(h4.Cells(j, "B"), lookat:=xlWhole)
            If Not b Is Nothing Then
                ncell = b.Address
                Do
                    If h1.Cells(i, "E") <= h4.Cells(b.Row, "H") Then
                        existe = True
                        bodega = h4.Cells(j, "B")
                        Exit For
                    End If
                    Set b = r.FindNext(b)
                Loop While Not b Is Nothing And b.Address <> ncell
            End If
        Next
        If existe Then
            h1.Cells(i, "D") = bodega
        Else
            h1.Cells(i, "D") = "Producto sin Stock"
        End If
    Next
    Application.ScreenUpdating = True
    MsgBox "Fin Buscar Bodega Sugerida", vbInformation, "Fecha: " & Date
End Sub

Saludos.Dante Amor

No olvides valorar la respuesta.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas