Macro para eliminar las filas a partir de la 4 que no coincidan con el texto de la celda ah1. (buscar dentro de la columna ah)
"para Dante Amor"
Macro para eliminar las filas a partir de la 4 que no coincidan con el texto de la celda ah1. (Buscar dentro de la columna ah).
Me parece que unos de los problemas que la macro se hace lenta es porque tengo muchos datos duplicados.
Dejo la macro que tengo y adjunto el link del archivo.
https://www.dropbox.com/s/kvzgihwzrcylmc0/ah1-clientes.xlsm?dl=0
Sub Eliminar_Diferentes2()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
dato = Range("AH1")
If dato = "" Then
MsgBox "Ingresa un dato en AH1"
Exit Sub
End If
'
For i = 2000 To 4 Step -1
If Cells(i, "AH") <> dato Then Rows(i).Delete
Next
MsgBox "Fin"
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
ActiveSheet.DisplayPageBreaks = True
Application.CutCopyMode = False
End Sub
Respuesta de Dante Amor
2
Envíame tu archivo para revisarlo, como te comenté, hice una prueba con 6000 registros y la respuesta es de 2 segundos
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “pablo ninguno” y el título de esta pregunta.
¡Gracias! Dante ya pude solucionarlo, igualmente muchas gracias por tu ayuda.
Dejo el código por si le sirve a alguien más.
Saludos
Sub QuitaFilas()
Dim uf&, i&, a, R As Range
Application.ScreenUpdating = False
uf = Range("AH" & Rows.Count).End(xlUp).Row
a = Range("AH1:AH" & uf)
For i = 4 To UBound(a)
If a(i, 1) <> Range("AH1") Then
If R Is Nothing Then
Set R = Range("AH" & i)
Else
Set R = Union(R, Range("AH" & i))
End If
End If
Next i
R.EntireRow.Delete
Set R = Nothing: Erase a
Range("AH4").Select
Application.ScreenUpdating = True
End Sub
