Excel emparejar datos iguales entre varias columnas
Quisiera hacerles la siguiente cuestión
En una hoja excel tengo en las columnas A, C y E nombres de materiales y en las columnas B, D y F las cantidades que tengo.
TORNILLO 2 TUERCA 6 CLAVO 6
CLAVO 5 MARTILLO 6 TORNILLO 7
Lo que necesito es una macro que ordene los datos emparejando los mismos de forma que empezando por la columna A, busque en la columna C y E el mismo nombre y lo sitúe en la misma fila, moviendo también la cantidad.
Y en caso de ser un dato único que quede solo en la fila.
Quedaría
TORNILLO 2 …… ……. TORNILLO 7
CLAVO 5 ….. …… CLAVO 6
……. …… TUERCA 6 …… ……
……. ……. MARTILLO 6 ….. ……
1 Respuesta
H o l a: Te anexo la macro
Cambia en la macro "Hoja1" por la hoja que contiene tus datos.
Crea una nueva hoja y la nombras como "Hoja2". En la "Hoja2" la macro pondrá los datos emparejados.
Sub Emparejar()
'Por.Dante Amor
Set h1 = Sheets("Hoja1") 'hoja con datos
Set h2 = Sheets("Hoja2") 'hoja nueva
'
h2.Cells.ClearContents
h1.Columns("A:B").Copy h2.Range("A1")
For i = 1 To h1.Range("C" & Rows.Count).End(xlUp).Row
Set b = h2.Columns("A").Find(h1.Cells(i, "C"), lookat:=xlWhole)
If Not b Is Nothing Then
h2.Cells(b.Row, "C") = h1.Cells(i, "C")
h2.Cells(b.Row, "D") = h1.Cells(i, "D")
Else
u1 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
u2 = h2.Range("C" & Rows.Count).End(xlUp).Row + 1
u = WorksheetFunction.Max(u1, u2)
h2.Cells(u, "C") = h1.Cells(i, "C")
h2.Cells(u, "D") = h1.Cells(i, "D")
End If
Next
'
'
For i = 1 To h1.Range("E" & Rows.Count).End(xlUp).Row
Set b = h2.Columns("A").Find(h1.Cells(i, "E"), lookat:=xlWhole)
If Not b Is Nothing Then
h2.Cells(b.Row, "E") = h1.Cells(i, "E")
h2.Cells(b.Row, "F") = h1.Cells(i, "F")
Else
Set b = h2.Columns("C").Find(h1.Cells(i, "E"), lookat:=xlWhole)
If Not b Is Nothing Then
h2.Cells(b.Row, "E") = h1.Cells(i, "E")
h2.Cells(b.Row, "F") = h1.Cells(i, "F")
Else
u1 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
u2 = h2.Range("C" & Rows.Count).End(xlUp).Row + 1
u3 = h2.Range("E" & Rows.Count).End(xlUp).Row + 1
u = WorksheetFunction.Max(u1, u2, u3)
h2.Cells(u, "E") = h1.Cells(i, "E")
h2.Cells(u, "F") = h1.Cells(i, "F")
End If
End If
Next
MsgBox "Proceso terminado", vbInformation, "EMPAREJAR"
End Sub'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
