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!
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