如何使用Excel VBA中的input框过滤数据透视表

我想用inputbox过滤数据透视表。 我需要使用户input的值可见，其他值必须是不可见的。 数据透视字段“数字”在行标签中。 我在代码中使用循环。 所以用户可以input多个值。 我用下面的代码，但问题是它不工作，并显示错误“下标超出范围”。 帮我

Sub FilterRP() Dim ws As Worksheet Dim str1 As Variant Dim arr1() As String Dim i As Long Set ws = Sheets("Main") i = 1 Do str1 = Application.InputBox("Select one Number") ReDim Preserve arr1(i) arr1(i) = str1 i = i + 1 Loop While (str1 <> vbNullString) And (str1 <> False) ws.PivotTables("MainTable").PivotFields("Number").ClearAllFilters ws.PivotTables("MainTable").PivotFields("Number").PivotItems(arr1(i)).Visible = True End Sub 

Answer 1

试试下面的代码，在代码的注释里面的解释：

 Option Explicit Sub FilterRP() Dim ws As Worksheet Dim str1 As Variant Dim arr1() As String Dim i As Long Dim PvtItm As PivotItem Set ws = Sheets("Main") i = 0 Do str1 = Application.InputBox("Select one Number") ReDim Preserve arr1(i) arr1(i) = str1 i = i + 1 Loop While (str1 <> vbNullString) And (str1 <> False) With ws.PivotTables("MainTable").PivotFields("Number") .ClearAllFilters ' reset previous filters ' loop through Pivot Items collection For Each PvtItm In .PivotItems If Not IsError(Application.Match(PvtItm.Name, arr1, 0)) Then ' check if current Pivot-Items's name equals to one of the selected values in Input-Box PvtItm.Visible = True Else PvtItm.Visible = False End If Next PvtItm End With End Sub 

Answer 2

你可以尝试做这样的事情。 它从InputBox一个由逗号分隔的input。 然后循环遍历数据透视字段中的每个项目“数字”设置数据中存在的值的可见性。 如果数组IsEmpty （即input框是vbNullString ），那么它将重置数据透视字段并返回所有项目。

 Sub FilterRP() Dim ws As Worksheet Dim str1 As Variant Dim arr1() As String Dim pi As PivotItem Set ws = Sheets("Main") str1 = InputBox("Please enter the numbers you want to filter by" & vbNewLine & "Seperated by a comma (,)") ' Remove spaces if any str1 = Trim(Replace(str1, " ", vbNullString)) arr1 = Split(str1, ",") With ws.PivotTables("MainTable").PivotFields("Number") For Each pi In .PivotItems If Not str1 = vbNullString Then pi.Visible = IIf(IsInArray(pi.Name, arr1), True, False) Else pi.Visible = True End If Next pi End With End Sub 

---

 Public Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean Dim i For i = LBound(arr) To UBound(arr) If arr(i) = stringToBeFound Then IsInArray = True Exit Function End If Next i IsInArray = False End Function