Buscar rango de Hoja 1 en Hoja 2 y copiar todas las filas coincidentes en Hoja 3 bajo condición de valor extra en Hoja 1
Tengo un archivo Excel con dos hojas.
- En Hoja1 tengo una lista de productos con las facturas en que aparecen:
- Producto 1 (col A) que aparece en Factura 1 (col B)
- Producto 1 (col A) que aparece en Factura 2 (col B)
- Producto 1 (col A) que aparece en Factura 3 (col B)
- Producto 2 (col A) que aparece en Factura 4 (col B)
- Producto 2 (col A) que aparece en Factura 5 (col B)
- Producto 2 (col A) que aparece en Factura 6 (col B)
- Producto 3 (col A) que aparece en Factura 7 (col B)
- Producto 3 (col A) que aparece en Factura 8 (col B)
- Producto 3 (col A) que aparece en Factura 9 (col B)
- En Hoja2 tengo una lista de los componentes que conforman cada producto:
- Producto 1 (col A) que contiene componente 1 (col B)
- Producto 1 (col A) que contiene componente 2 (col B)
- Producto 1 (col A) que contiene componente 3 (col B)
- Producto 2 (col A) que contiene componente 4 (col B)
- Producto 2 (col A) que contiene componente 5 (col B)
- Producto 2 (col A) que contiene componente 6 (col B)
- Producto 3 (col A) que contiene componente 7 (col B)
- Producto 3 (col A) que contiene componente 8 (col B)
- Producto 3 (col A) que contiene componente 9 (col B)
Necesito una macro que en Hoja3 me genere un listado que incluya por cada combinación de producto y factura en Hoja1 los componentes que lo conforman según Hoja2:
- Producto 1 (col A), Factura 1 (col B), Componente 1 (col C)
- Producto 1 (col A), Factura 1 (col B), Componente 2 (col C)
- Producto 1 (col A), Factura 1 (col B), Componente 3 (col C)
- Producto 1 (col A), Factura 2 (col B), Componente 1 (col C)
- Producto 1 (col A), Factura 2 (col B), Componente 2 (col C)
- Producto 1 (col A), Factura 2 (col B), Componente 3 (col C)
- Producto 1 (col A), Factura 3 (col B), Componente 1 (col C)
- Producto 1 (col A), Factura 3 (col B), Componente 2 (col C)
- Producto 1 (col A), Factura 3 (col B), Componente 3 (col C)
- Producto 2 (col A), Factura 4 (col B), Componente 4 (col C)
- Producto 2 (col A), Factura 4 (col B), Componente 5 (col C)
- Producto 2 (col A), Factura 4 (col B), Componente 6 (col C)
- Producto 2 (col A), Factura 5 (col B), Componente 4 (col C)
- Producto 2 (col A), Factura 5 (col B), Componente 5 (col C)
- Producto 2 (col A), Factura 5 (col B), Componente 6 (col C)
- Producto 2 (col A), Factura 6 (col B), Componente 4 (col C)
- Producto 2 (col A), Factura 6 (col B), Componente 5 (col C)
- Producto 2 (col A), Factura 6 (col B), Componente 6 (col C)
- Producto 3 (col A), Factura 7 (col B), Componente 7 (col C)
- Producto 3 (col A), Factura 7 (col B), Componente 8 (col C)
- Producto 3 (col A), Factura 7 (col B), Componente 9 (col C)
- Producto 3 (col A), Factura 8 (col B), Componente 7 (col C)
- Producto 3 (col A), Factura 8 (col B), Componente 8 (col C)
- Producto 3 (col A), Factura 8 (col B), Componente 9 (col C)
- Producto 3 (col A), Factura 9 (col B), Componente 7 (col C)
- Producto 3 (col A), Factura 9 (col B), Componente 8 (col C)
- Producto 3 (col A), Factura 9 (col B), Componente 9 (col C)
1 Respuesta
Respuesta de Dante Amor
1
Visita:
Cursos de Excel y Macros
---
Cursos de Excel:
https://www.youtube.com/watch?v=w7MYL3wDgH4&t=3s
https://www.youtube.com/watch?v=dy9w9zbkCaw&t=644s
https://www.youtube.com/watch?v=7Xhs04vhrtg&t=188s
---
Asumiendo que en Hoja1 y en Hoja2, los datos empiezan en la fila 2, prueba la siguiente macro:
Sub Generar_Listado()
'Por Dante Amor
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
Dim c As Range, r As Range, f As Range
Dim cell As String
Dim i As Long
Set sh1 = Sheets("Hoja1")
Set sh2 = Sheets("Hoja2")
Set sh3 = Sheets("Hoja3")
Set r = Sheets("Hoja2").Range("A:A")
i = 2
For Each c In sh1.Range("A2", sh1.Range("A" & Rows.Count).End(xlUp))
Set f = r.Find(c.Value, , xlValues, xlWhole, , , False)
If Not f Is Nothing Then
cell = f.Address
Do
sh3.Range("A" & i).Value = sh1.Range("A" & c.Row).Value
sh3.Range("B" & i).Value = sh1.Range("B" & c.Row).Value
sh3.Range("C" & i).Value = sh2.Range("B" & f.Row).Value
i = i + 1
Set f = r.FindNext(f)
Loop While Not f Is Nothing And f.Address <> cell
End If
Next
MsgBox "Fin", vbInformation, "Excel y Macros"
End SubCursos de Macros:
https://www.youtube.com/watch?v=PupmVvM16-8&t=1s
https://www.youtube.com/watch?v=f_x8pstpNqc&t=3s
https://www.youtube.com/watch?v=5k0szqErdXg&t=689s
---
Sal u dos Dante Amor
