Agilizar macro

Alguien me podría decir como puedo agilizar una macro, se demora mucho activando un filtro avanzado

1 Respuesta

Respuesta
1
Debieras escribir aquí la macro para ver si realmente el problema es el filtro u otras instrucciones...
Anexo Código
    If UCase(Range("A18").Value) = "X" Then MsgBox ("Seleccione el Mes"), , "Aviso"
    If UCase(Range("A18").Value) = "X" Then Exit Sub
    If UCase(Range("A20").Value) = "X" Then MsgBox ("No Existen Datos"), , "Aviso"
    If UCase(Range("A20").Value) = "X" Then Exit Sub
    Call Desprotege
    Sheets("IngresaDatos").Visible = True
    Sheets("HorasXPersonal").Visible = True
    Sheets("HorasXPersonal").Select
    Range("A3:O20003").Select
    Selection.ClearContents
    Range("A3").Select
    Sheets("IngresaDatos").Select
    Range("H41:AB20042").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange _
        :=Range("H38:H39"), Unique:=False
    Range("L42:Z20042").Select
    Selection.Copy
    Sheets("HorasXPersonal").Select
    Range("A3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A2").Select
    Sheets("IngresaDatos").Select
    Range("H41:AB41").Select
    Selection.AutoFilter
    Selection.AutoFilter
    ActiveWindow.SmallScroll Down:=21
    ActiveWindow.SmallScroll Down:=-42
    Range("K2").Select
    Sheets("HorasXPersonal").Select
    ActiveSheet.PivotTables("HorasPersonal").PivotCache.Refresh
    Sheets("IngresaDatos").Visible = False
    Sheets("Principal").Visible = False
    Call Protege
El código salvo pequeños detalles que dejo a continuación, está perfecto.
Si luego igual se demora ya tiene que ver con la cantidad de datos y la capacidad de tu procesador para realizar cálculos.
Te escribo la rutina como yo la dejaría
Sub filtrando() 
(ver*)
If UCase(Range("A18").Value) = "X" Then MsgBox ("Seleccione el Mes"), , "Aviso": Exit Sub
    'If UCase(Range("A18").Value) = "X" Then Exit Sub 
    If UCase(Range("A20").Value) = "X" Then MsgBox ("No Existen Datos"), , "Aviso": Exit Sub
    'If UCase(Range("A20").Value) = "X" Then Exit Sub
    Call Desprotege        'colocar línea de desprotección  (**)
    Sheets("IngresaDatos").Visible = True
    Sheets("HorasXPersonal").Visible = True
    Sheets("HorasXPersonal").Select
    Range("A3:O20003").Select
    Selection.ClearContents
    Range("A3").Select
    Sheets("IngresaDatos").Select
    Application.Calculation = xlManual   'opcional (***)
    Range("H41:AB20042").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange _
        :=Range("H38:H39"), Unique:=False
    'copiar solo hasta la última celda con datos  (****)
    ulti = Range("L65536").End(xlUp).Row
    Range("L42:Z" & ulti).Select

    Selection.Copy
    Sheets("HorasXPersonal").Select
    Range("A3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A2").Select
    Sheets("IngresaDatos").Select
    Range("H41:AB41").Select
    Selection.AutoFilter
    Selection.AutoFilter
    Application.Calculation = xlAutomatic   'opcional  (***)
    'ActiveWindow.SmallScroll Down:=21   'no hace falta mover el scroll, directamente selecciona la celda K2
    'ActiveWindow.SmallScroll Down:=-42
    Range("K2").Select
    Sheets("HorasXPersonal").Select
    ActiveSheet.PivotTables("HorasPersonal").PivotCache.Refresh
    Sheets("IngresaDatos").Visible = False
    Sheets("Principal").Visible = False
    Call Protege        'colocar línea de protección (**)
End Sub
(*) No es necesario repetir el if, podes realizar las 2 operaciones en 1 solo.
(**) Una rutina de desprotección seguramente no tiene 1 de 1 línea... entonces para que llamar a otra subrutina si podes colocar esa línea directamente aquí.
Lo mismo para la protección
(***) Probá de colocar el cálculo en manual y observá el tiempo insumido de un modo u otro.
(****) Para que copiar y pegar hasta la fila 20.000 si quizás solo tengas datos hasta la 500, mejor establecé la última celda considerando la col que no tendrá espacios en blanco, por ahora quedó la col L
Espero te sirvan las ideas.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas