Macro lenta

2 envíos / 0 nuevos
Último envío
anet_paola8
Imagen de anet_paola8
Offline
última acción: Hace 2 meses 1 semana
alta: 27/09/2018 - 18:04
Puntos: 25
Macro lenta

Hola,

Tengo una macro que cada que selecciono en unas pivot un filtro puede cambiar la pivot de ser de 40 líneas a 4, entonces me oculta las líneas vacías para ver todas las pivots seguidas, pero se tarda al menos 40seg. en correr, me podrían ayudar?

Sub Mostrar()

'Mostrar filas ocultas

Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual

ActiveSheet.DisplayPageBreaks = False

Rows.EntireRow.Hidden = False

'Ocultar lineas

ActiveSheet.Rows("20:200").Hidden = False

For f = 20 To 200

If Cells(f, 1).Value = "" Then Cells(f, 1).EntireRow.Hidden = True

Application.ScreenUpdating = True

Application.Calculation = xlCalculationAutomatic

Application.EnableEvents = True

ActiveSheet.DisplayPageBreaks = True

Application.CutCopyMode = False

Next

End Sub

 

Corre con un call:

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)

Call Mostrar

End Sub

 

Muchas gracias!

 

Etiquetas: 

Cron
Imagen de Cron
Offline
última acción: Hace 5 horas 8 mins
Nivel 1 - 200 puntosNivel 2 - 500 puntosNivel 3 - 1000 puntosNivel 4 - 2000 puntosNivel 5 - 4000 puntos
alta: 23/06/2010 - 12:30
Puntos: 11310
Se me ocurre que pueda ir

Se me ocurre que pueda ir lento por tres cosas:

1- cálculo de las tablas dinámicas

2- Ocultar filas de una en una (se pueden ocultar todas de una vez)

3- En tu código estás activando todo lo que habías desactivado para que fuera más rápido en cada iteración. Saca del bucle desde Screenupdating hasta cutcopymode (que no creo que te haga falta) y verás una mejoría.

 

Para ocultar las filas de una vez podríamos ir añadiendo a un rango cada fila que debamos ocultar. Un ejemplo podría ser este:

Sub Mostrar()

Dim fila As Long

Dim rango As Range

 

On error goto fin

'Mostrar filas ocultas

Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual

ActiveSheet.DisplayPageBreaks = False

Rows.EntireRow.Hidden = False

Set rango = Cells(1, 1)   'Para utilizar luego Union, rango no puede estar vacío. Asigno un valor fuera de nuestro rango de trabajo que luego machaco para no ocultar esta fila.

For fila= 20 To 200

    If Cells(fila, 1).Value = "" Then

        If rango.Address = "$A$1" Then

            Set rango = Cells(fila, 1).EntireRow

        Else

            Set rango = Union(rango, Cells(fila, 1).EntireRow)

        End If

    End If

Next

    rango.EntireRow.Hidden = True

fin:

Application.ScreenUpdating = True

Application.Calculation = xlCalculationAutomatic

Application.EnableEvents = True

ActiveSheet.DisplayPageBreaks = True

Application.CutCopyMode = False

End Sub

 

Un saludo