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
1 Respuesta
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 SubSaludos.Dante Amor
No olvides valorar la respuesta.
