Sub Actualizar_Rapido()
'
' Macro2 Macro
'
Dim Total_Lineas_A As Long, Fila_A As Long, Codigo_A As String, New_Hoja As String, _
Total_Lineas_T As Long, Fila_T As Long, Codigo_T As String, Fin As Byte
Dim Inicio As Long
Inicio = Timer
' EXPLICACION PASO a PASO
Application.ScreenUpdating = False ' Evita que refresque mientras se
' ejecuta la MACRO.
Application.DisplayAlerts = False ' Evita los mensajes de aviso, en este
' caso cuando Borra la Nueva Hoja.
' -1- Busco el número de filas en las columnas Hoja2.A y Hoja1.T
Total_Lineas_A = Sheets("Hoja2").Range("A1").End(xlDown).Row Total_Lineas_T = Sheets("Hoja1").Range("T1").End(xlDown).Row
' -2- Añado una hoja y guardo el nombre que el sistema le dio
Sheets.Add After:=Sheets(Sheets.Count)
New_Hoja = ActiveSheet.Name
' ===== Hoja nueva ACTIVA =====
' -3- Copia la columna A de la hoja2 a la columna A de la nueva hoja
' Copia la columna J de la hoja2 a la columna B de la nueva hoja
Sheets("Hoja2").Range("A:A").Copy Sheets(New_Hoja).Range("A1") Sheets("Hoja2").Range("J:J").Copy Sheets(New_Hoja).Range("B1")
' -4- Ordena las columnas A y B por el valor de la A
Columns("A:B").Select Application.CutCopyMode = False
ActiveWorkbook.Worksheets(New_Hoja).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(New_Hoja).Sort.SortFields.Add _
Key:=Range("A2:A" & Total_Lineas_A), _ SortOn:=xlSortOnValues, _
Order:=xlAscending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(New_Hoja).Sort
.SetRange Range("A1:B" & Total_Lineas_A) .Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Columns("A:B").EntireColumn.AutoFit
' -5- Copia la columna T de la hoja1 a la columna T de la nueva hoja
Sheets("Hoja1").Range("T:T").Copy Sheets(New_Hoja).Range("T1")
' -6- En la columna U pongo un numerador para saber la línea de origen
Sheets(New_Hoja).Select
Range("U1") = 1 Range("U2") = 2 Range("U3") = 3
Range("U1:U3").Select Range("U3").Activate Selection.AutoFill Destination:=Range("U1:U" & Total_Lineas_T) Range("U1:U" & Total_Lineas_T).Select
' -7- Ordena las columnas T y U por el valor de la T
Columns("T:U").Select
ActiveWorkbook.Worksheets(New_Hoja).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(New_Hoja).Sort.SortFields.Add _
Key:=Range("T2:T" & Total_Lineas_T), _ SortOn:=xlSortOnValues, _
Order:=xlAscending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(New_Hoja).Sort
.SetRange Range("T1:U" & Total_Lineas_T) .Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
' -8- Como tengo las dos columnas ordenadas A y T voy recorriendo
' las dos columnas de forma secuencial para comparar.
'
' Si son iguales Tomo el valor de la columna B que es el mismo que el
' de la columna J de la Hoja2 para el mismo codigo de las columna A
' aunque este en diferente linea.
'
' Y lo copio a la columna U de la hoja1 en la fila que esta el codigo
' de la columna T en la hoja1 que es lo que me indica el número de la
' columna U de la nueva Hoja
Fila_A = 2 ' -- Esta es la columna A de la hoja2
Fila_T = 2 ' -- Esta es la Columna T de la hoja1
Fin = 0
While Fin = 0
Codigo_A = Cells(Fila_A, 1)
Codigo_T = Cells(Fila_T, 20)
If Codigo_A = Codigo_T Then
Sheets(New_Hoja).Range("B" & Fila_A).Copy Sheets("Hoja1").Range("U" & Cells(Fila_T, 21)) Fila_A = Fila_A + 1
Else
If Codigo_A < Codigo_T Then
Fila_A = Fila_A + 1
Else
Fila_T = Fila_T + 1
End If
End If
If Fila_A > Total_Lineas_A Then Fin = 1
If Fila_T > Total_Lineas_T Then Fin = 1
Wend
' -9- Y una vez finalizado ELIMINO la nueva hoja
Sheets(New_Hoja).Select
ActiveWindow.SelectedSheets.Delete
MsgBox "MACRO Finalizada" & vbCrLf & vbCrLf & _
"Tiempo de ejecucion: " & Format(Timer - Inicio, "#.## seg."), _
vbInformation + vbOKOnly, "M A C R O"
End Sub
