2012-06-17 7 views
6

का उपयोग कर एक्सेल पिवट तालिका फ़िल्टर करें मैंने वीबीए का उपयोग कर Excel में पिवट तालिका को फ़िल्टर करने का प्रयास करने के लिए हमेशा इंटरनेट से समाधान कॉपी और पेस्ट करने का प्रयास किया है। नीचे दिया गया कोड काम नहीं करता है।वीबीए

Sub FilterPivotTable() 
    Application.ScreenUpdating = False 
    ActiveSheet.PivotTables("PivotTable2").ManualUpdate = True 
    ActiveSheet.PivotTables("PivotTable2").PivotFields("SavedFamilyCode").CurrentPage = "K123223" 
    ActiveSheet.PivotTables("PivotTable2").ManualUpdate = False 
    Application.ScreenUpdating = True 
End Sub 

मैं फ़िल्टर करना चाहते हैं तो मैं सभी पंक्तियों SavedFamilyCode K123223 है कि देखते हैं। मैं पिवट टेबल में कोई अन्य पंक्तियां नहीं देखना चाहता हूं। मैं चाहता हूं कि यह पिछले फिल्टर के बावजूद काम करे। मुझे उम्मीद है कि आप इसके साथ मेरी मदद कर सकते हैं। धन्यवाद!

Sub FilterPivotField() 
    Dim Field As PivotField 
    Field = ActiveSheet.PivotTables("PivotTable2").PivotFields("SavedFamilyCode") 
    Value = Range("$A$2") 
    Application.ScreenUpdating = False 
    With Field 
     If .Orientation = xlPageField Then 
      .CurrentPage = Value 
     ElseIf .Orientation = xlRowField Or .Orientation = xlColumnField Then 
      Dim i As Long 
      On Error Resume Next ' Needed to avoid getting errors when manipulating fields that were deleted from the data source. 
      ' Set first item to Visible to avoid getting no visible items while working 
      .PivotItems(1).Visible = True 
      For i = 2 To Field.PivotItems.Count 
       If .PivotItems(i).Name = Value Then _ 
        .PivotItems(i).Visible = True Else _ 
        .PivotItems(i).Visible = False 
      Next i 
      If .PivotItems(1).Name = Value Then _ 
       .PivotItems(1).Visible = True Else _ 
       .PivotItems(1).Visible = False 
     End If 
    End With 
    Application.ScreenUpdating = True 
End Sub 

दुर्भाग्य से मैं चलाने के लिए मिल टाइम त्रुटि 91: ऑब्जेक्ट सेट नहीं चर या के साथ ब्लॉक चर


मैं कोशिश कर रहा हूँ अपनी पोस्ट के आधार पर। इस त्रुटि के कारण क्या हुआ है?

+2

क्या आपने मैक्रो रिकॉर्ड करने का प्रयास किया था? –

+0

मैं उप FilterPivotTable() की तर्ज पर कुछ ActiveSheet.PivotTables ("PivotTable2") के साथ मिलता है। PivotFields ("SavedFamilyCode") .PivotItems ("K010")। दर्शनीय = सच .PivotItems ("K012") .Visible = झूठी के साथ समाप्त End Sub लेकिन मैं सब K010 को छोड़कर अदृश्य मैक्रो रिकॉर्डर बनना चाहते हैं पर ध्यान नहीं देता मेरा चयन/होने वाले सभी क्लिक – user1283776

उत्तर

2

पाइवट टेबल कॉन्फ़िगर इतना है कि यह इस तरह है:

enter image description here

अब आपका कोड बस रेंज ("बी 1") पर काम कर सकते हैं और पाइवट टेबल आप के लिए फ़िल्टर होगी आवश्यक SavedFamilyCode

Sub FilterPivotTable() 
Application.ScreenUpdating = False 
    ActiveSheet.Range("B1") = "K123224" 
Application.ScreenUpdating = True 
End Sub 
5

फ़ील्ड। CurrentPage केवल फ़िल्टर फ़ील्ड (पृष्ठ फ़ील्ड भी कहा जाता है) के लिए काम करता है।
आप एक पंक्ति/स्तंभ क्षेत्र फ़िल्टर करना चाहते हैं, तो आप अलग-अलग आइटम के माध्यम से चक्र करने के लिए है, इसलिए जैसे:

Sub FilterPivotField(Field As PivotField, Value) 
    Application.ScreenUpdating = False 
    With Field 
     If .Orientation = xlPageField Then 
      .CurrentPage = Value 
     ElseIf .Orientation = xlRowField Or .Orientation = xlColumnField Then 
      Dim i As Long 
      On Error Resume Next ' Needed to avoid getting errors when manipulating PivotItems that were deleted from the data source. 
      ' Set first item to Visible to avoid getting no visible items while working 
      .PivotItems(1).Visible = True 
      For i = 2 To Field.PivotItems.Count 
       If .PivotItems(i).Name = Value Then _ 
        .PivotItems(i).Visible = True Else _ 
        .PivotItems(i).Visible = False 
      Next i 
      If .PivotItems(1).Name = Value Then _ 
       .PivotItems(1).Visible = True Else _ 
       .PivotItems(1).Visible = False 
     End If 
    End With 
    Application.ScreenUpdating = True 
End Sub 

उसके बाद, आप बस कहेंगे:

FilterPivotField ActiveSheet.PivotTables("PivotTable2").PivotFields("SavedFamilyCode"), "K123223" 

जाहिर है, इस मैदान में अलग-अलग अलग-अलग वस्तुएं धीमी हो जाती हैं। यदि आप अपनी आवश्यकताओं को बेहतर तरीके से उपयुक्त करते हैं तो आप नाम के बजाय SourceName का भी उपयोग कर सकते हैं।

+0

@ user1283776 के जवाब में (एक साल में कभी नहीं से देर से बेहतर चयन रद्द करें) - आपको शायद त्रुटि मिल रही है क्योंकि आपको 'सेट फ़ील्ड = ...' – savyuk

+0

का उपयोग करना चाहिए मेरे लिए काम मुझे समय बचाएं! – Mike

1

मुझे लगता है कि मैं आपका प्रश्न समझ रहा हूं। यह उन चीजों को फ़िल्टर करता है जो कॉलम लेबल या पंक्ति लेबल में हैं। कोड के अंतिम 2 खंड आप जो चाहते हैं, लेकिन मैं सबकुछ चिपका रहा हूं ताकि आप यह देख सकें कि यह परिभाषित करता है कि यह परिभाषित करता है कि यह परिभाषित करने वाली सभी चीज़ों के साथ कैसे समाप्त होता है। मैंने निश्चित रूप से इस साइट को कुछ अन्य साइटों से लिया है।

कोड के अंत के पास, "WardClinic_Category" मेरे डेटा का एक स्तंभ और पिवट तालिका के कॉलम लेबल में है। IVUDDCIndicator के लिए वही (यह मेरे डेटा में एक स्तंभ है लेकिन पिवट तालिका के पंक्ति लेबल में)।

उम्मीद है कि इससे दूसरों की मदद मिलती है ... मुझे यह पता लगाना बहुत मुश्किल लगता है कि मैक्रो रिकॉर्डर के समान कोड का उपयोग करने के बजाय यह "उचित तरीका" था।

Sub CreatingPivotTableNewData() 


'Creating pivot table 
Dim PvtTbl As PivotTable 
Dim wsData As Worksheet 
Dim rngData As Range 
Dim PvtTblCache As PivotCache 
Dim wsPvtTbl As Worksheet 
Dim pvtFld As PivotField 

'determine the worksheet which contains the source data 
Set wsData = Worksheets("Raw_Data") 

'determine the worksheet where the new PivotTable will be created 
Set wsPvtTbl = Worksheets("3N3E") 

'delete all existing Pivot Tables in the worksheet 
'in the TableRange1 property, page fields are excluded; to select the entire PivotTable report, including the page fields, use the TableRange2 property. 
For Each PvtTbl In wsPvtTbl.PivotTables 
If MsgBox("Delete existing PivotTable!", vbYesNo) = vbYes Then 
PvtTbl.TableRange2.Clear 
End If 
Next PvtTbl 


'A Pivot Cache represents the memory cache for a PivotTable report. Each Pivot Table report has one cache only. Create a new PivotTable cache, and then create a new PivotTable report based on the cache. 

'set source data range: 
Worksheets("Raw_Data").Activate 
Set rngData = wsData.Range(Range("A1"), Range("H1").End(xlDown)) 


'Creates Pivot Cache and PivotTable: 
Worksheets("Raw_Data").Activate 
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rngData.Address, Version:=xlPivotTableVersion12).CreatePivotTable TableDestination:=wsPvtTbl.Range("A1"), TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion12 
Set PvtTbl = wsPvtTbl.PivotTables("PivotTable1") 

'Default value of ManualUpdate property is False so a PivotTable report is recalculated automatically on each change. 
'Turn this off (turn to true) to speed up code. 
PvtTbl.ManualUpdate = True 


'Adds row and columns for pivot table 
PvtTbl.AddFields RowFields:="VerifyHr", ColumnFields:=Array("WardClinic_Category", "IVUDDCIndicator") 

'Add item to the Report Filter 
PvtTbl.PivotFields("DayOfWeek").Orientation = xlPageField 


'set data field - specifically change orientation to a data field and set its function property: 
With PvtTbl.PivotFields("TotalVerified") 
.Orientation = xlDataField 
.Function = xlAverage 
.NumberFormat = "0.0" 
.Position = 1 
End With 

'Removes details in the pivot table for each item 
Worksheets("3N3E").PivotTables("PivotTable1").PivotFields("WardClinic_Category").ShowDetail = False 

'Removes pivot items from pivot table except those cases defined below (by looping through) 
For Each PivotItem In PvtTbl.PivotFields("WardClinic_Category").PivotItems 
    Select Case PivotItem.Name 
     Case "3N3E" 
      PivotItem.Visible = True 
     Case Else 
      PivotItem.Visible = False 
     End Select 
    Next PivotItem 


'Removes pivot items from pivot table except those cases defined below (by looping through) 
For Each PivotItem In PvtTbl.PivotFields("IVUDDCIndicator").PivotItems 
    Select Case PivotItem.Name 
     Case "UD", "IV" 
      PivotItem.Visible = True 
     Case Else 
      PivotItem.Visible = False 
     End Select 
    Next PivotItem 

'turn on automatic update/calculation in the Pivot Table 
PvtTbl.ManualUpdate = False 


End Sub 
1

एक्सेल के नवीनतम संस्करणों में स्लाइसर नामक एक नया टूल है। वीबीए में स्लाइसर्स का उपयोग करना वास्तव में अधिक विश्वसनीय है। CurrentPage (कई फ़िल्टर विकल्पों के माध्यम से लूपिंग करते समय बग की रिपोर्टें हुई हैं)। यहाँ कैसे आप एक स्लाइसर आइटम का चयन कर सकते हैं का एक सरल उदाहरण है (सभी गैर-प्रासंगिक स्लाइसर मूल्यों का चयन रद्द करने के लिए याद):

Sub Step_Thru_SlicerItems2() 
Dim slItem As SlicerItem 
Dim i As Long 
Dim searchName as string 

Application.ScreenUpdating = False 
searchName="Value1" 

    For Each slItem In .VisibleSlicerItems 
     If slItem.Name <> .SlicerItems(1).Name Then _ 
      slItem.Selected = False 
     Else 
      slItem.Selected = True 
     End if 
    Next slItem 
End Sub 

वहाँ भी SmartKato जैसी सेवाओं है कि आप अपने डैशबोर्ड की स्थापना के साथ बाहर में मदद मिलेगी रहे हैं या रिपोर्ट और/या अपने कोड को ठीक करें।

1

एक्सेल 2007 में के बाद, आप बहुत सरल कोड के रूप में इस का उपयोग कर सकते हैं:

dim pvt as PivotTable 
dim pvtField as PivotField 

set pvt = ActiveSheet.PivotTables("PivotTable2") 
set pvtField = pvt.PivotFiles("SavedFamilyCode") 

pvtField.PivotFilters.Add xlCaptionEquals, Value1:= "K123223" 
2

आप यदि चाहें तो इस जांच कर सकता है। :) इस कोड

उपयोग करता है, तो SavedFamilyCode रिपोर्ट फ़िल्टर में है:

Sub FilterPivotTable() 
    Application.ScreenUpdating = False 
    ActiveSheet.PivotTables("PivotTable2").ManualUpdate = True 

    ActiveSheet.PivotTables("PivotTable2").PivotFields("SavedFamilyCode").ClearAllFilters 

    ActiveSheet.PivotTables("PivotTable2").PivotFields("SavedFamilyCode").CurrentPage = _ 
     "K123223" 

    ActiveSheet.PivotTables("PivotTable2").ManualUpdate = False 
    Application.ScreenUpdating = True 
    End Sub 

लेकिन अगर SavedFamilyCode स्तंभ या पंक्ति लेबल में है इस कोड का उपयोग:

Sub FilterPivotTable() 
    Application.ScreenUpdating = False 
    ActiveSheet.PivotTables("PivotTable2").ManualUpdate = True 

     ActiveSheet.PivotTables("PivotTable2").PivotFields("SavedFamilyCode").ClearAllFilters 

     ActiveSheet.PivotTables("PivotTable2").PivotFields("SavedFamilyCode").PivotFilters. _ 
    Add Type:=xlCaptionEquals, Value1:="K123223" 

    ActiveSheet.PivotTables("PivotTable2").ManualUpdate = False 
    Application.ScreenUpdating = True 
    End Sub 

उम्मीद है कि यह आपकी मदद करता है।