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

Question

之前我问过关于如何更改数据透视域“行”的问题 (VBA, Application-defined or Object Error, changing Pivot Filter)。但是，更改“过滤器”字段似乎有所不同。

这是我用来使用 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

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

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"。如果此处的代码不能解决问题，则需要根据数据类型添加逻辑。

Answer 2

数据透视的过滤器部分看起来像日期格式，但您的原始数据是一个看起来像日期的字符。

虽然原始数据格式是纯日期数据格式，但枢轴过滤器是用文本表示的。但是，如果原始数据是字符，则应使用xlCaptionEquals，如果原始数据是日期格式，则应使用xlSpecificDate。

但是，value1 的所有值都必须是 String 格式。因此，您需要准确掌握原始数据的格式，并将其识别为图片中的文本数据。