< návrat zpět

MS Excel

Téma: Konting. tabulky Filtr podle hodnoty v buňce rss

Zaslal/a Martinius 6.2.2017 13:38

Zdravím,

Mám několik kontingenčních tabulek (data z ext.zdroje), které filtruji pomocí hodnoty v buňkách přes vba.

Rád bych dané macro zjednodušil hlavně kvůli rychlosti provedení. Tedy níže uvedený code/příklad zakomponoval do SELECT CASE.

Sub PivotFilter()

Application.ScreenUpdating = False

If Sheets("List1").Range("AG1").Value > 0 Then

'Nastaveni proměnných
Dim pt As PivotTable
Dim pt1 As PivotTable
Dim pt2 As PivotTable
Dim pt3 As PivotTable

Dim Field As PivotField
Dim Field1 As PivotField
Dim Field2 As PivotField
Dim Field3 As PivotField

Dim NewCat As String
Dim NewCatP As String

'Nastavení kontingenční tabulky
Set pt = Worksheets("List1").PivotTables("Data") 'Nastavení názvů kontingenční tabulky
Set pt1 = Worksheets("List1").PivotTables("Hodnota")
Set pt2 = Worksheets("List1").PivotTables("Pozice")
Set pt3 = Worksheets("List1").PivotTables("Souhrn")

Set Field = pt.PivotFields("ID_smart") 'Nastavení FILTRU/hodnoty, která se má měnit v kontingenční tabulce
Set Field1 = pt1.PivotFields("ID_smart")
Set Field2 = pt2.PivotFields("ID_lost")
Set Field3 = pt3.PivotFields("ID_lost")

NewCat = Worksheets("List1").Range("AG1").Value ' Hodnota bunky určující co se má zobrazovat v kontingenční tabulce - FILTR
NewCatP = Worksheets("List1").Range("AG4").Value

'Update dat
With pt
Field.ClearAllFilters
Field.CurrentPage = NewCat
pt.RefreshTable
End With

With pt1
pt1.RefreshTable
End With

With pt2
Field2.ClearAllFilters
Field2.CurrentPage = NewCatP
pt2.RefreshTable
End With

With pt3
Field3.ClearAllFilters
Field3.CurrentPage = NewCatP
pt3.RefreshTable
End With

End If

Application.ScreenUpdating = True

End Sub

Zaslat odpověď >
Jeza.m(6.2.2017 15:30)#034822
Jeza.m
Select case se taky hodí, ale víc by se asi hodila smyčka.
Zkusil jsem jen tak bez testu ...
Public Sub FiltrStart()
Application.ScreenUpdating = False
Dim LIST_PT()
Dim LIST_FI()
LIST_PT = Array("Data", "Hodnota", "Pozice", "Souhrn")
LIST_FI = Array("ID_smart", "ID_smart", "ID_lost", "ID_lost")

Dim NewCat As String
Dim NewCatP As String

NewCat = Worksheets("List1").Range("AG1").value
NewCatP = Worksheets("List1").Range("AG4").value

For ind = 0 To UBound(LIST_PT)
Select Case LIST_PT(ind)
Case Is = "Data"
Filtry LIST_PT(ind), LIST_FI(ind), NewCat, True
Case Is = "Hodnota"
Filtry LIST_PT(ind), LIST_FI(ind), "", False
Case Else
Filtry LIST_PT(ind), LIST_FI(ind), NewCatP, True
End Select
Next
Application.ScreenUpdating = True
End Sub

Public Sub Filtry(ktaname As String, fieldname As String, nvalue As String, clearfilters As Boolean)

Dim pt As PivotTable
Dim Field As PivotField

Set pt = Worksheets("List1").PivotTables(ktaname)
Set Field = pt.PivotFields(fieldname)

If clearfilters = True Then
pt.Field.ClearAllFilters
pt.Field.currentpage = nvalue
End If

pt.RefreshTable
End Subcitovat
Martinius(6.2.2017 16:12)#034823
avatar
Tak to testuji a vyskočilo hlášení: ByRef argument type mismatch...citovat
lubo(6.2.2017 17:26)#034824
avatar
No otázka je na makro, ale možná by to šlo bez makra. Zkusil jsi použít průřezy? Jeden na pt a druhý na pt2 a pt3?citovat
Martinius(10.2.2017 17:07)#034881
avatar
Nakonec jsem zjednodušil vba code pro filtr na: buňka A1 se rovná buňce AG1 atd. + time obnova spolu s refreshpivottable.... 1

Ale děkuji za pomoccitovat

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Helios iNuvio

Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.

On-line nástroje