Ordenar varias columnas independientemente entre sí
Mi objetivo es ordenar 4 columnas, con datos de fechas, por orden decreciente. Tengo el siguiente código que lo hace, pero mi pregunta es si se puede aligerar el mismo, para evitar tantas líneas de código y aumentar su velocidad. El rango de datos en cada columna puede ser diferente, unas columnas pueden tener más datos que otras.
Gracias de antemano
Sub Ordena_Registros()
Range("AK4:AK5000").Select
ActiveWorkbook.Worksheets("iLab").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("iLab").Sort.SortFields.Add Key:=Range("AK4:AK5000") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("iLab").Sort
.SetRange Range("AK3:AK5000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("AL4:AL5000").Select
ActiveWorkbook.Worksheets("iLab").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("iLab").Sort.SortFields.Add Key:=Range("AL4:AL5000") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("iLab").Sort
.SetRange Range("AL3:AL5000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("AM4:AM5000").Select
ActiveWorkbook.Worksheets("iLab").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("iLab").Sort.SortFields.Add Key:=Range("AM4:AM5000") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("iLab").Sort
.SetRange Range("AM3:AM5000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("AN4:AN5000").Select
ActiveWorkbook.Worksheets("iLab").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("iLab").Sort.SortFields.Add Key:=Range("AN4:AN5000") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("iLab").Sort
.SetRange Range("AN3:AN5000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
A la mejora en el código enviado por Marcial, también debieras mejorar el tiempo de proceso.
Si tu hoja tiene fórmulas se irá actualizando con cada cambio y ese es el principal motivo de la demora. No influyen tanto lineas más o líneas menos.
Entonces te quedaría algo así:
Sub Ordena()
'comentado x Elsamatilde
'pasar a modo manual
Application.Calculation = xlCalculationManual
'seleccionar solo el rango con datos
With Range("AK4:AK" & Range("AK" & Rows.Count).End(xlUp).Row)
.Sort key1:=.Cells(1, 1), order1:=xlDescending
End With
'ajustar rango según modelo en col AK
With Range("AL4:AL5000")
.Sort key1:=.Cells(1, 1), order1:=xlDescending
End With
'ajustar rango según modelo en col AK
With Range("AM4:AM5000")
.Sort key1:=.Cells(1, 1), order1:=xlDescending
End With
'ajustar rango según modelo en col AK
With Range("AN4:AN5000")
.Sort key1:=.Cells(1, 1), order1:=xlDescending
End With
'volver a modo de cálculo automático
Application.Calculation = xlCalculationAutomatic
End Sub
1 respuesta más de otro experto
Prueba esto:
Sub Ordena()
With Range("AK4:AK5000")
.Sort key1:=.Cells(1, 1), order1:=xlDescending
End With
With Range("AL4:AL5000")
.Sort key1:=.Cells(1, 1), order1:=xlDescending
End With
With Range("AM4:AM5000")
.Sort key1:=.Cells(1, 1), order1:=xlDescending
End With
With Range("AN4:AN5000")
.Sort key1:=.Cells(1, 1), order1:=xlDescending
End With
End SubSi te ha valido la respuesta.
Incluso puedes tener menos código, si introduces en un array los rangos a ordenar
Sub Ordena()
Rangos = Array("AK4:AK5000", "AL4:AL5000", "AM4:AM5000", "AN4:AN5000")
For t = LBound(Rangos) To UBound(Rangos)
With Range(Rangos(t))
.Sort key1:=.Cells(1, 1), Header:=xlYes, order1:=xlDescending
End With
Next t
End Sub