excel - VBA，根据输入值更改数据透视字段“过滤器”

Question

以前我问过关于如何更改数据透视域“行”的问题（VBA，应用程序定义或对象错误，更改数据透视过滤器）。但是，更改“过滤器”字段似乎有所不同。

这是我用来用 vba 更改可透视表的“行”值的代码，Period它是我的透视表中的“过滤器”字段。当我运行它时，我收到一条错误消息Could not apply filter，这是用户错误处理。

Dim pivTable1 As PivotTable

    
    Set pivTable1 = GetPivotTable(ThisWorkbook, "Summary of LoBs", "PivotTable1")
    If pivTable1 Is Nothing Then
        MsgBox "Missing Pivot Table", vbInformation, "Cancelled"
        Exit Sub
    End If
    pivTable1.PivotCache.Refresh
    
    
    Dim periodField As PivotField
    
    On Error Resume Next
    Set periodField = pivTable1.PivotFields("Period")
    On Error GoTo 0
    If periodField Is Nothing Then
        MsgBox "Missing Pivot Field", vbInformation, "Cancelled"
        Exit Sub
    End If
    periodField.ClearAllFilters
    

    

    Dim filterDate As Variant
    
    On Error Resume Next
    filterDate = ThisWorkbook.Worksheets("Input").Range("H2").Value2
    If Err.Number <> 0 Then
        Err.Clear
        MsgBox "Missing Filter Date", vbInformation, "Cancelled"
        Exit Sub
    End If
    
    'Try String first
    If VarType(filterDate) = vbString Then
        periodField.PivotFilters.Add Type:=xlCaptionEquals, Value1:=filterDate
        If Err.Number = 0 Then Exit Sub
        
        filterDate = CDbl(CDate(filterDate))
        Err.Clear
    End If
    
    If VarType(filterDate) <> vbDouble Then
        MsgBox "Invalid Filter Date", vbInformation, "Cancelled"
        Exit Sub
    End If
    
    'Try Date (as Double data type)
    periodField.PivotFilters.Add Type:=xlSpecificDate, Value1:=filterDate
    If Err.Number <> 0 Then
        Err.Clear
        MsgBox "Could not apply filter", vbInformation, "Cancelled"
        Exit Sub
    End If

任何帮助，将不胜感激。谢谢。

标签： excelvba

Answer 1

我添加了一个解决这两种情况（行或字段）的选择案例：

Sub ApplyFilter()
    Dim pivTable1 As PivotTable

    Set pivTable1 = GetPivotTable(ThisWorkbook, "Summary of LoBs", "PivotTable1")
    If pivTable1 Is Nothing Then
        MsgBox "Missing Pivot Table", vbInformation, "Cancelled"
        Exit Sub
    End If
    pivTable1.PivotCache.Refresh
    
    Dim periodField As PivotField
    
    On Error Resume Next
    Set periodField = pivTable1.PivotFields("Period")
    On Error GoTo 0
    If periodField Is Nothing Then
        MsgBox "Missing Pivot Field", vbInformation, "Cancelled"
        Exit Sub
    End If
    periodField.ClearAllFilters
    
    Dim filterDate As Variant
    
    On Error Resume Next
    filterDate = ThisWorkbook.Worksheets("Input").Range("H2").Value2
    If Err.Number <> 0 Then
        Err.Clear
        MsgBox "Missing Filter Date", vbInformation, "Cancelled"
        Exit Sub
    End If
    
    Select Case periodField.Orientation
    Case xlRowField
        'Try String first
        If VarType(filterDate) = vbString Then
            periodField.PivotFilters.Add Type:=xlCaptionEquals, Value1:=filterDate
            If Err.Number = 0 Then Exit Sub
            
            filterDate = CDbl(CDate(filterDate))
            Err.Clear
        End If
        
        If VarType(filterDate) <> vbDouble Then
            MsgBox "Invalid Filter Date", vbInformation, "Cancelled"
            Exit Sub
        End If
        
        'Try Date (as Double data type)
        periodField.PivotFilters.Add Type:=xlSpecificDate, Value1:=filterDate
        If Err.Number <> 0 Then
            Err.Clear
            MsgBox "Could not apply filter", vbInformation, "Cancelled"
            Exit Sub
        End If
    Case xlPageField
        Dim pivItem As PivotItem
        Dim v As Variant
        
        For Each pivItem In periodField.PivotItems
            v = pivItem.Value
            If VarType(v) = VarType(filterDate) Then
                pivItem.Visible = (v = filterDate)
            Else
                'Try converting to date
                If IsDate(v) And IsDate(filterDate) Then
                    pivItem.Visible = (CDate(v) = CDate(filterDate))
                Else
                    'Add other logic based on your needs
                    Err.Raise 5, , "Need more code here"
                End If
            End If
        Next pivItem
    Case Else
        MsgBox "Could not apply filter!" & vbNewLine & "Field must be a <Row> or <Filter> field!", vbInformation, "Cancelled"
    End Select
End Sub

但是，您会看到一条评论'Add other logic based on your needs"。如果此处的代码不能解决问题，则需要根据数据类型添加逻辑。