Merhabalar,
Aşağıdaki kod ile aynı sayfada bulunan tüm Pivot lar da tek seferde filtreleme yapabiliyorum.
E58 hücresinde ki değeri referans alarak filtreleme yapıyor. Mesela 10 yazarsam ilk 10 değeri görüyorum.
Kodun çalışmasıyla ilgili bir sorun yok, yalnızca pivotta birden fazla değer varsa her zaman ilk alana ait değeri alıp filtreleme yapıyor.
Örneğin 1.değer alanı hedef, 2.değer alanı gerçekleşen, 3.değer alanı gerçekleşen oranıysa, kod ile yalnızca 1.değer alanını filtreleyebiliyorum. Ama benim istediğim 3.değer alanına göre filtreleme yapmak. Çok araştırdım denedim ancak ben bir yol bulamadım. Yardımcı olabilirseniz çok sevinirim..
Aşağıdaki kod ile aynı sayfada bulunan tüm Pivot lar da tek seferde filtreleme yapabiliyorum.
E58 hücresinde ki değeri referans alarak filtreleme yapıyor. Mesela 10 yazarsam ilk 10 değeri görüyorum.
Kodun çalışmasıyla ilgili bir sorun yok, yalnızca pivotta birden fazla değer varsa her zaman ilk alana ait değeri alıp filtreleme yapıyor.
Örneğin 1.değer alanı hedef, 2.değer alanı gerçekleşen, 3.değer alanı gerçekleşen oranıysa, kod ile yalnızca 1.değer alanını filtreleyebiliyorum. Ama benim istediğim 3.değer alanına göre filtreleme yapmak. Çok araştırdım denedim ancak ben bir yol bulamadım. Yardımcı olabilirseniz çok sevinirim..
Kod:
Option Explicit
Private Sub Worksheet_Change _
(ByVal Target As Range)
Dim ws As Worksheet
Dim wsL As Worksheet
Dim pt As PivotTable
Dim pf As PivotField
Dim pfD As PivotField
Dim rngType As Range
Dim rngTypeSel As Range
Dim rngNum As Range
Dim lType As Long
If Intersect(Target, [E58]) Is Nothing Then Exit Sub
If [E58] = "TOP 10" Then
Rows("77:173").EntireRow.Hidden = True
ElseIf [E58] = "ALL" Then
Rows("77:173").EntireRow.Hidden = False
Else
MsgBox "İşlem Yapılmadı"
End If
On Error GoTo errHandler
Set ws = ActiveSheet
Set wsL = Worksheets("Lists")
Set rngType = ws.Range("TypeSel")
Set rngTypeSel _
= wsL.Range("TypeValSel")
Set rngNum = ws.Range("NumSel")
Select Case Target.Address
Case rngType.Address, _
rngNum.Address
Application.ScreenUpdating = False
Application.EnableEvents = False
For Each pt In ws.PivotTables
Set pf = pt.RowFields(1)
Set pfD = pt.DataFields(1)
pf.ClearAllFilters
If rngNum.Value > 0 And _
rngTypeSel > 0 Then
pf.PivotFilters.Add _
Type:=rngTypeSel.Value, _
DataField:=pfD, _
Value1:=rngNum.Value
End If
Next pt
End Select
exitHandler:
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub
errHandler:
MsgBox "Filtre Uygulanamadı"
Resume exitHandler
End Sub
Gerçekten inanılmaz.
