Lọc bảng tổng hợp Excel bằng VBA

Question

Tôi đã thử sao chép và dán các giải pháp từ internet mãi mãi để cố gắng lọc bảng tổng hợp trong Excel bằng VBA. Mã bên dưới không hoạt động.

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 

Tôi muốn lọc để tôi thấy tất cả các hàng có SavedFamilyCode K123223. Tôi không muốn thấy bất kỳ hàng nào khác trong bảng tổng hợp. Tôi muốn điều này làm việc bất kể các bộ lọc trước đó. Tôi hy vọng bạn có thể giúp tôi với điều này. Cảm ơn!

---

Dựa trên bài viết của bạn tôi đang cố gắng:

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 

Đáng tiếc là tôi nhận Run time error 91: Object biến khối biến hoặc Với không được thiết lập. Điều gì đã gây ra lỗi này?

Answer 1

Cấu hình bảng pivot để nó là như thế này:

Mã của bạn chỉ đơn giản là có thể làm việc trên phạm vi ("B1") bây giờ và pivot table sẽ được lọc để bạn yêu cầu SavedFamilyCode

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

Answer 2

Field.CurrentPage chỉ hoạt động đối với trường Bộ lọc (còn gọi là trường trang).
Nếu bạn muốn lọc một lĩnh vực hàng/cột, bạn phải vòng qua các mục cá nhân, như vậy:

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 

Sau đó, bạn sẽ chỉ cần gọi:

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

Đương nhiên, điều này chậm hơn thì có nhiều mục khác nhau trong trường. Bạn cũng có thể sử dụng SourceName thay vì Tên nếu phù hợp với nhu cầu của bạn tốt hơn.

Answer 3

Tôi nghĩ rằng tôi hiểu câu hỏi của bạn. Điều này lọc những thứ nằm trong nhãn cột hoặc nhãn hàng. Hai phần cuối của mã là những gì bạn muốn nhưng im dán tất cả mọi thứ để bạn có thể thấy chính xác cách nó chạy bắt đầu để kết thúc với tất cả mọi thứ thats được xác định vv Tôi chắc chắn đã lấy một số mã này từ các trang web khác fyi.

Gần cuối mã, "WardClinic_Category" là cột của dữ liệu của tôi và trong nhãn cột của bảng tổng hợp. Tương tự cho IVUDDCIndicator (một cột của nó trong dữ liệu của tôi nhưng trong nhãn hàng của bảng tổng hợp).

Hy vọng điều này sẽ giúp người khác ... tôi thấy rất khó để tìm mã mà đã làm điều này "cách thích hợp" thay vì sử dụng mã tương tự như máy ghi vĩ mô.

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 

Answer 4

Phiên bản Excel mới nhất có công cụ mới có tên Slicers. Sử dụng máy thái trong VBA thực sự đáng tin cậy hơn .CurrentPage (đã có báo cáo lỗi trong khi lặp qua nhiều tùy chọn bộ lọc). Dưới đây là một ví dụ đơn giản về cách bạn có thể chọn một mục slicer (nhớ bỏ chọn tất cả các giá trị slicer không liên quan):

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 

Ngoài ra còn có các dịch vụ như SmartKato mà có thể giúp bạn ra ngoài với việc thiết lập biểu đồ của bạn hoặc báo cáo và/hoặc sửa mã của bạn.

Answer 5

Trong Excel 2007 trở đi, bạn có thể sử dụng mã đơn giản hơn nhiều như sau:

dim pvt as PivotTable 
dim pvtField as PivotField 

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

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

Answer 6

Bạn có thể kiểm tra điều này nếu bạn muốn. :)

Sử dụng mã này nếu SavedFamilyCode là trong Báo cáo Lọc:

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 

Nhưng nếu SavedFamilyCode là trong cột hoặc Row Labels sử dụng mã này:

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 

Hy vọng điều này sẽ giúp bạn.