Slicerselectie met vba zeer traag

[Samsung6713]

Goedemiddag,

ik wil een gedeelte van een datalijst kopieren.
Hiervoor heb ik er een draaitabel van gemaakt, en daar 2 slicers in gezet.
Nu wil ik de slicerselectie met vba doen, echter zoals de code nu werkt is dit enorm traag.
Hoe krijg ik de code zo dat het een vlotter werkt?

Sub selectie_uitvoerder()
'
' selectie_uitvoerder
'

'
    For Each slcCache In ActiveWorkbook.SlicerCaches
        slcCache.ClearManualFilter
Next

    With ActiveWorkbook.SlicerCaches("Slicer_Uitvoerder")
    
    For Each oSlicerItem In .SlicerItems
        If oSlicerItem.Name = "naam uitvoerder" Then
            oSlicerItem.Selected = True
        Else
            oSlicerItem.Selected = False
        End If
    Next oSlicerItem
    
    End With
End Sub

 

[jkpieterse]

Screenupdating en calculation tijdelijk uitzetten moet al flink helpen

 

[VenA]

gebruik het geavanceerde filter of plaats het bestand.

 

[Samsung6713]

Sub selectie_uitvoerder ()

 Application.ScreenUpdating = False
 Application.Calculation = xlManual
'
' selectie_uitvoerder Macro
'

'
    For Each slcCache In ActiveWorkbook.SlicerCaches
        slcCache.ClearManualFilter
Next

    With ActiveWorkbook.SlicerCaches("Slicer_Uitvoerder")
    
    For Each oSlicerItem In .SlicerItems
        If oSlicerItem.Name = "Naam uitvoerder" Then
            oSlicerItem.Selected = True
        Else
            oSlicerItem.Selected = False
        End If
    Next oSlicerItem
    
    End With
    Application.Calculation = xlAutomatic
      Application.ScreenUpdating = True
End Sub

Bovenstaande helpt wel wat, maar nog steeds duurt het meer dan 15 seconden.

Het bestand plaatsen is geen optie, dus ga nu aan de slag met het advanced filter.

Bedankt voor de tips

 

[jkpieterse]

Advanced filter is niet voor draaitabellen toch?

 

[Samsung6713]

Voor zover als ik nu kan vinden werkt een advanced filter niet op een draaitabel.

 

[jkpieterse]

Kan je niet de bron tabel filteren ik denk dat dat is wat VenA bedoelt

 

[E v R]

Wellicht helpt de pivot(s) even op manualupdate zetten:

Sub selectie_uitvoerder()

 Application.ScreenUpdating = False
 Application.Calculation = xlManual

'
' selectie_uitvoerder Macro
'

'
    For Each slcCache In ActiveWorkbook.SlicerCaches
        slcCache.ClearManualFilter
    Next

    With ActiveWorkbook.SlicerCaches("Slicer_Uitvoerder")
    For Each piv In .PivotTables
         piv.ManualUpdate = True
    Next
    
    For Each oSlicerItem In .SlicerItems
        If oSlicerItem.Name = "Naam uitvoerder" Then
            oSlicerItem.Selected = True
        Else
            oSlicerItem.Selected = False
        End If
    Next oSlicerItem

    For Each piv In .PivotTables
         piv.ManualUpdate = False
    Next
    
    End With
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
    
End Sub

 

[VenA]

@jkpieterse,

Kan je niet de bron tabel filteren ik denk dat dat is wat VenA bedoelt

Was inderdaad wat ik bedoelde omdat dit in de OP staat:

ik wil een gedeelte van een datalijst kopieren.

Het geavanceerde filter werkt ook gewoon met een draaitabel. Bij gebrek aan een voorbeeldbestand zelf maar wat in elkaar gedraaid.

Sub VenA()
  c00 = "Type"
  For Each it In ActiveWorkbook.SlicerCaches("Slicer_Type").SlicerItems
    If it.Selected Then c00 = c00 & "|" & it.Name
  Next it
  x = Split(c00, "|")
  Cells(1, 26).Resize(UBound(x) + 1) = Application.Transpose(x)
  If Cells(1, 16) <> "" Then Cells(1, 16).CurrentRegion.Clear
  ActiveSheet.PivotTables(1).TableRange1.AdvancedFilter xlFilterCopy, Cells(1, 26).CurrentRegion, Cells(1, 16)
  Cells(1, 26).CurrentRegion.Clear
End Sub

 

[Samsung6713]

Wellicht helpt de pivot(s) even op manualupdate zetten:

Sub selectie_uitvoerder()

 Application.ScreenUpdating = False
 Application.Calculation = xlManual

'
' selectie_uitvoerder Macro
'

'
    For Each slcCache In ActiveWorkbook.SlicerCaches
        slcCache.ClearManualFilter
    Next

    With ActiveWorkbook.SlicerCaches("Slicer_Uitvoerder")
    For Each piv In .PivotTables
         piv.ManualUpdate = True
    Next
    
    For Each oSlicerItem In .SlicerItems
        If oSlicerItem.Name = "Naam uitvoerder" Then
            oSlicerItem.Selected = True
        Else
            oSlicerItem.Selected = False
        End If
    Next oSlicerItem

    For Each piv In .PivotTables
         piv.ManualUpdate = False
    Next
    
    End With
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
    
End Sub

Ik krijg de foutmelding compileerfout als ik dat in de code zet

    For Each slcCache In ActiveWorkbook.SlicerCaches
        slcCache.ClearManualFilter
        
         For Each piv In .PivotTables
         piv.ManualUpdate = True
Next

    With ActiveWorkbook.SlicerCaches("Slicer_Uitvoerder")
    
    For Each oSlicerItem In .SlicerItems
        If oSlicerItem.Name = "uitvoerder" Then
            oSlicerItem.Selected = True
        Else
            oSlicerItem.Selected = False
        End If
        
        For Each piv In .PivotTables
         piv.ManualUpdate = False
         
    Next oSlicerItem
    
    
    End With

 

[Samsung6713]

Het geavanceerde filter werkt ook gewoon met een draaitabel. Bij gebrek aan een voorbeeldbestand zelf maar wat in elkaar gedraaid.

Werkt dit ook met een tabel meer dan 30000 rijen en 15 kolommen? Of wordt het dan ook heel traag.

 

[VenA]

Dat kan je het beste zelf proberen.

Nb. Het quoten is niet nodig.

 

[E v R]

Ik krijg de foutmelding compileerfout als ik dat in de code zet

Je moet het er wel goed inzetten, (of 1:1 overnemen?)

 

[Samsung6713]

Iedereen bedankt voor het meedenken!
@Erik dat was de oplossing, het werkt nu bijna direct in plaats van de meer dan 15 seconden eerst.