Macro para ordenar datos de celdas
Tengo dos paquetes de datos, con un código de numeración (columna A y E). Quisiera que se ordenaran ambos paquetes, intercalando los datos que están en ambas columnas y los que solo aparecen en una u otra.
He conseguido con la función =CONTAR. SI, determinar cuales son los las celdas que no están duplicadas, la función devuelve un O, y en caso de estar en las dos columnas da un 1. Lo que no consigo es que desplacen los datos para que quede como se refleja en la imagen.
Si se puede hacer por medio de una macro, mejor.
1 Respuesta
Respuesta de Dante Amor
1
H o l a:
Te anexo la macro.
Primero, tus datos deberán empezar en la fila 2.
Pon tus datos en la "Hoja1"
Crea una hoja llamada "Hoja2".
Ejecuta la siguiente macro y el resultado quedará en la "Hoja2".
Sub OrdenarDatos()
'Por.Dante Amor
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
'
h2.Cells.ClearContents
h1.Columns("A:G").Copy h2.Range("R1")
u1 = h2.Range("R" & Rows.Count).End(xlUp).Row
h2.Range("Q2:Q" & u1) = 1
'
u2 = h2.Range("V" & Rows.Count).End(xlUp).Row
h2.Range("U2:U" & u2) = 2
h2.Range("U2:X" & u2).Copy h2.Range("Q" & u1 + 1)
'
u3 = h2.Range("Q" & Rows.Count).End(xlUp).Row
With h2.Sort
.SortFields.Clear: .SortFields.Add Key:=h2.Range("R2:R" & u3)
.SetRange h2.Range("Q2:T" & u3): .Header = xlGuess: .Apply
End With
'
j = 2
For i = 2 To h2.Range("Q" & Rows.Count).End(xlUp).Row
If h2.Cells(i, "Q") = 1 Then
If h2.Cells(j, "A") <> "" Then j = j + 1
h2.Range("R" & i, "T" & i).Copy h2.Cells(j, "A")
Else
If h2.Cells(i, "R") <> h2.Cells(j, "A") And h2.Cells(j, "A") <> "" Then j = j + 1
h2.Range("R" & i, "T" & i).Copy h2.Cells(j, "E"): j = j + 1
End If
Next
End Sub
