Excel Forum - Porady, Pomoc, Excel Help, Excel FAQ - Filtrowanie określonych wartości w tabeli przestawnej

cepats · Świeżak Posty: 8

Witam serdecznie

Od jakiegoś czasu zastanawiam się nad problemem filtrowania za pomocą makra w tabeli przestawnej. Chcę utworzyć makro które po przypisaniu do przycisku w szybki sposób pokazywało by jasno określone parametry z danej kolumny tabeli (tak jak to się robi za pomocą filtru ręcznego).
Załączam plik z przykładową tabelą. Załóżmy że chcę z kolumny "Nazwa artykułu" ustawić filtr pokazujący trzy parametry: 493241, 479651 oraz 512116

Udało mi się zrobić to co zamierzam jednak po aktywacji makra filtrowanie trwało bardzo długo i zastanawiam się w jak najprostszy sposób można to osiągnąć bez zbędnego czekania.

Będę bardzo wdzięczny za pomoc
Pozdrawiam

problem.xlsx

Pobierz Plik ściągnięto 118 raz(y) 412.45 KB

cepats · Świeżak Posty: 8

Dodam jeszcze że dokładnie to co chcę aby makro wykonało robi poniższe polecenie:

Kod:

Sub szukane()
Dim PI As PivotItem
With ActiveSheet.PivotTables("Tabela przestawna2").PivotFields("Numer artykulu")
.ClearAllFilters
For Each PI In .PivotItems
Select Case PI
Case "512116", "512017": PI.Visible = True
Case Else: PI.Visible = False
End Select
Next PI
End With
End Sub

Jednak tak jak wcześniej wspominałem trwa to bardzo długo.
Pozdrawiam

DwaNiedźwiedzie · Wysłany: 24-11-2017, 16:35

Na początku kodu dopisz:

Kod:

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
ActiveSheet.PivotTables("Tabela przestawna2").ManualUpdate = True

...a na końcu oczywiście przywróć pierwotne wartości - u mnie przeliczanie spadło z 20. do 6. sekund :)

kulasart · Wysłany: 24-11-2017, 18:21

Jeżeli ma być naprawdę szybko to polecam coś takiego:

Kod:

Option Explicit

Sub szukaneFast()
Dim pi As PivotItem
Dim firstItem
Dim fieldOrientation

With Application
.Application.ScreenUpdating = False
.Application.Calculation = xlCalculationManual
End With

ActiveSheet.PivotTables("Tabela przestawna2").ManualUpdate = True

With ActiveSheet.PivotTables("Tabela przestawna2").PivotFields("Numer artykulu")
fieldOrientation = .Orientation

For Each pi In .PivotItems
If pi.RecordCount > 0 Then
firstItem = pi.Value
Exit For
End If
Next

.ClearAllFilters
.Orientation = xlPageField
.EnableMultiplePageItems = False
.CurrentPage = firstItem

For Each pi In .PivotItems
If pi.Value = "512116" Or pi.Value = "512017" Then
pi.Visible = True
End If
Next pi

.Orientation = fieldOrientation

If firstItem <> "512116" And firstItem <> "512017" Then
.PivotItems(firstItem).Visible = False
End If

End With

With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With

MsgBox "end"
End Sub

Należy przy tym bardzo mocno podkreślić, że nie jest to rozwiązanie, które będzie błyskawiczne za każdym razem. Są pewne warunki, po spełnieniu których trzeba obrać trochę inny kierunek.

cepats · Świeżak Posty: 8

kulasart · Wysłany: 24-11-2017, 20:22

1) Otwierasz plik jaki załączyłeś do pierwszego posta.
2) Przechodzisz do edytora VBA (np. poprzez wciśnięcie ALT+F11)
3) Dodajesz nowy moduł (Menu "Insert", "Module")
4) W nowym module wstawiasz kod jaki podałem
5) Uruchamiasz

kulasart · Wysłany: 24-11-2017, 22:13

OK, zapomnij o moim rozwiązaniu - wygląda na to że faktycznie nie działa.

cepats · Świeżak Posty: 8

Cezary Czajka · Wysłany: 25-11-2017, 15:03

Może tak. Wklej to, co ma być filtrowane o odśwież wszystko

problem.xlsx

Pobierz Plik ściągnięto 100 raz(y) 397.72 KB

cepats · Świeżak Posty: 8

Dziękuję wszystkim za pomoc. Okazało się ze poniższy kod działa dla mnie wystarczająco szybko i robi robotę :->

Kod:

Sub szukane()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Sheets("_SUROWCE_").PivotTables("Tabela przestawna2").ManualUpdate = True
Dim pi As PivotItem
With Sheets("_SUROWCE_").PivotTables("Tabela przestawna2").PivotFields("Numer artykulu")
.ClearAllFilters
For Each pi In .PivotItems
Select Case pi
Case "512116", "512017", "552000", "563041": pi.Visible = True
Case Else: pi.Visible = False
End Select
Next pi
End With
Application.ScreenUpdating = True
Sheets("_SUROWCE_").PivotTables("Tabela przestawna2").ManualUpdate = False
Sheets("_SUROWCE_").Select

End Sub

Niestety pojawił się kolejny mały problem. Generalnie dane z tej tabeli są zaciągane z systemu magazynowego i przedstawiają aktualne stany magazynowe. Filtrowane przedmioty o numerach np "512116" przedstawiają jeden ze składników wyrobu gotowego.

Kod:

Case "512116", "512017", "552000", "563041": pi.Visible = True

Dla łatwiejszego planowania chcę aby z setek numerów po aktywacji konkretnego makro filtr pokazywał tylko części składowe jednego produktu. Niestety w momencie kiedy dany numer magazynowy np "512116" aktualnie jest pusty i nie ma go w tabeli przestawnej to po włączeniu makra wyskakuje błąd run-time error 1004 - ustawienie Visible klasy Pivotitem nie jest możliwe. Jest to w pełni logiczne bo jak ma coś widoczne skoro w danym momencie nie istnieje :)

Czy ma ktoś pomysł w jaki sposób zastosować jakiś warunek aby w tym przypadku makro pokazywało prawidłowo wszystkie aktualnie dostępne przedmioty z pominięciem tego pustego artykułu? Będę bardzo wdzięczny za pomoc.

Pozdrawiam

BluEEyE · Świeżak Wersja: Win Office 365 Posty: 5

Witam,

Nie chcę zakładać nowego wątku, a spotkałem się dokładnie z takim samym problem. Mam zmienną "FS", którą szukam w filtrze. Problem jest taki, że nie w każdym tygodniu ten produkt jest produkowany. Jeśli jest produkowany to poniższy kod działa prawidłowo.

Kod:

Sub GS_weekly()
'
' GS_weekly Makro
'
' Klawisz skrótu: Ctrl+n
'

Dim week As String
Dim FS As String
Dim cost As String

week = Application.InputBox("Podaj numer tygodnia folderu, z którego danych chcesz skorzystać ?")

If TypeName(week) = "Boolean" Then Exit Sub
On Error Resume Next

FS = Application.InputBox("Podaj nr FS, dla którego dane wyciągnę ?")
If TypeName(FS) = "Boolean" Then Exit Sub
On Error Resume Next

cost = Application.InputBox("Podaj kolumnę, w której umieścić dane ?")
If TypeName(cost) = "Boolean" Then Exit Sub
On Error Resume Next

Windows("QR4 WK" & week & ".xlsx").Activate

Sheets("Arkusz3").Activate

With ActiveSheet.PivotTables("Tabela_przestawna_QR4_3").PivotFields("fin_style_id")
.ClearAllFilters

For Each PI In .PivotItems
Select Case PI
Case "" & FS & "": PI.Visible = True
Case Else: PI.Visible = False
End Select
If PI.Name = "(blank)" Then Exit For
Next PI
End With

Windows("Bierun Lamination WK" & week & " 2021.xlsm").Activate

Sheets("" & FS & "").Activate

Range("AI3").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(VLOOKUP(RC[-20],'[QR4 WK" & week & ".xlsx]Arkusz3'!R8C1:R72C2,2,FALSE),0)"
Range("AI3").Select
Selection.AutoFill Destination:=Range("AI3:AI12"), Type:=xlFillDefault
Range("AI3:AI12").Select
Selection.Copy
Range("" & cost & "3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("AI15").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
"=IFERROR(VLOOKUP(R[-13]C[-33],'[LE WK" & week & ".xlsx]PV_value'!R4C1:R284C2,2,FALSE),0)"
Range("AI15").Select
Selection.Copy
Range("" & cost & "15").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("AI").EntireColumn.Hidden = True

End Sub

Problem zaczyna się właśnie robić, gdy dana wartość zapisana jako zmienna "FS" nie jest widoczna filtrze więc wtedy makro zgodnie z kodem przeszukuje cały PivotFields("fin_style_id") i zaznacza ten ostatni widoczny, a następnie kopiuje z niego dane zamiast wpisywać zera.

W jaki sposób to rozwiązać, aby do pliku "Bierun Lamination WK" & week & " 2021.xlsm" były wpisywane same zera w odpowiednie komórki, jeśli makro nie znajdzie w PivotFields wartosći zapisanej pod zmienną "FS" ?

Dzięki wielkie za pomoc.