Macro buscar datos y copiar en nueva hoja
Es un gusto saludarlos nuevamente.
Si es posible, solicito por favor su ayuda con lo siguiente:
En la hoja1 se encuentra una serie de datos en la columna A, más de 500 mil.
En la hoja2 (matriz) se encuentra otra serie de datos tambien en la columa A, 500 mil apróx.
Por favor su ayuda con lo siguiente:
1.- Realizar macro que busque los datos contenidos en la hoja1 en la hoja2 (la hoja2 es la matriz) y traiga
la columna B, en terminos de excel es BuscarV (=BUSCARV(A2;Hoja2!$A$2:$H$999999;2;0).
2.- En el caso de que no encuentre el valor (#N/A), marcar con un color los datos que no existan en la hoja1
presentes en la columna A.
3.- Tomar todos los datos que no existen en hoja1 columna A, y copiarlos en una nueva hoja, hoja3.
1 respuesta
Te anexo la macro.
Realicé una prueba con 100,000 registros y se tardó aproximadamente 2 minutos 20 segundos.
Para que la macro sea más rápida, te sugiero que cuando ejecutes la macro, solamente tengas abierta la aplicación de excel.
En la barra de estatus de excel (esquina inferior izquierda), veras un contador, para que sepas cuántos registros se han procesado.
Cambia en la macro los nombres de las hojas por los que tu tengas:
Set h1 = Sheets("Hoja1") 'Datos a buscar
Set h2 = Sheets("Hoja2") 'Hoja Matriz
Set h3 = Sheets("Hoja3") 'Hoja con datos no encontradosLa macro:
Sub BuscarDatos()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.StatusBar = False
Set h1 = Sheets("Hoja1") 'Datos a buscar
Set h2 = Sheets("Hoja2") 'Hoja Matriz
Set h3 = Sheets("Hoja3") 'Hoja con datos no encontrados
'
h1.Columns("A").Interior.ColorIndex = xlNone
h1.Columns("B").ClearContents
h3.Cells.Clear
'
u1 = h1.Range("A" & Rows.Count).End(xlUp).Row
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To u1
Application.StatusBar = "Procesando registro " & i & " de " & u1
Set b = h2.Range("A1:A" & u2).Find(h1.Cells(i, "A"), lookat:=xlWhole)
If Not b Is Nothing Then
h1.Cells(i, "B") = h2.Cells(b.Row, "B")
Else
h1.Cells(i, "A").Interior.ColorIndex = 6
u3 = h3.Range("A" & Rows.Count).End(xlUp).Row + 1
h3.Cells(u3, "A") = h1.Cells(i, "A")
End If
Next
Application.ScreenUpdating = True
Application.StatusBar = False
MsgBox "Terminado", vbInformation
End Sub
Muchas gracias Dante!!
Solo una cosa, como lo puedo hacer para que en la columna B de la hoja1, los datos que no corresponden y no se encuentran en hoja2 aparezca la palabra "No Existe"?
Quedaría así:
Sub BuscarDatos()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.StatusBar = False
Set h1 = Sheets("Hoja1") 'Datos a buscar
Set h2 = Sheets("Hoja2") 'Hoja Matriz
Set h3 = Sheets("Hoja3") 'Hoja con datos no encontrados
'
h1.Columns("A").Interior.ColorIndex = xlNone
h1.Columns("B").ClearContents
h3.Cells.Clear
'
u1 = h1.Range("A" & Rows.Count).End(xlUp).Row
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To u1
Application.StatusBar = "Procesando registro " & i & " de " & u1
Set b = h2.Range("A1:A" & u2).Find(h1.Cells(i, "A"), lookat:=xlWhole)
If Not b Is Nothing Then
h1.Cells(i, "B") = h2.Cells(b.Row, "B")
Else
h1.Cells(i, "A").Interior.ColorIndex = 6
h1.Cells(i, "B") = "No existe"
u3 = h3.Range("A" & Rows.Count).End(xlUp).Row + 1
h3.Cells(u3, "A") = h1.Cells(i, "A")
End If
Next
Application.ScreenUpdating = True
Application.StatusBar = False
MsgBox "Terminado", vbInformation
End Sub
Perfecto Dante muchas gracias!!!
Un abrazo!!
Hola Dante, perdón por seguir con este tema, pero como puedo hacer para que los datos de la hoja1 que no se encuentran pintados de color (datos que estarían ok) se peguen en una nueva
hoja, hoja4?
Por favor tu ayuda!!
Ya te envié la macro en la nueva pregunta que realizaste.
