excel - 使用单元格值过滤日期之间的数据透视表
问题描述
我有一个数据透视表,其中列出了在某个日期范围内售出的库存商品数量。开始日期和开始日期存储在单元格中,因此用户可以修改它们。
我编写了引用这些单元格的代码并尝试过滤工作表上的数据透视表。
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = ActiveSheet.Range("E3").Address Then
ActiveSheet.PivotTables("ItemsSold").RefreshTable
ElseIf Target.Address = ActiveSheet.Range("I3").Address Then
ActiveSheet.PivotTables("ItemsSold").RefreshTable
End If
ActiveSheet.PivotTables("ItemsSold").PivotFields("Date Sold ").PivotFilters.Add _
Type:=xlDateBetween, _
Value1:=CLng(Range("E3").value), _
Value2:=CLng(Range("I3").value)
End Sub
我明白了
“运行时错误 1004:应用程序定义或对象定义错误”。
刷新表正常工作,但过滤它不是。
另一个复杂情况:如果表格中不存在其中一个日期(例如,日期从:),这会起作用吗?例如,如果我想在 1 月 1 日和今天之间进行过滤,但数据表中没有 1 月的日期,那么这段代码是否仍能正常执行?
解决方案
Date Sold
字段可以位于行或列标签区域,或报告过滤器区域,如屏幕截图所示:
行标签区域
报告筛选区域
以下代码应粘贴到工作表模块中,它由两个子部分组成,第一个用于处理位于报表过滤器区域的字段,第二个用于行或列标签区域:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rFrom As Range
Dim rUpto As Range
Dim lFrom As Long
Dim lUpto As Long
Dim oPivotField As PivotField
Dim oPivotItem As PivotItem
Dim sFmt As String
Dim bItemVisible As Boolean
Dim cPivotFilters As PivotFilters
Dim oFilter As PivotFilter
Set rFrom = ActiveSheet.Range("E3")
Set rUpto = ActiveSheet.Range("I3")
If Target.Address = rFrom.Address Or Target.Address = rUpto.Address Then
Set oPivotField = ActiveSheet.PivotTables("ItemsSold").PivotFields("Date Sold")
Select Case oPivotField.Orientation
' Check if field located in Report Filter area
Case xlPageField
' Prepare for update
Application.EnableEvents = False
Application.ScreenUpdating = False
On Error Resume Next ' to be sure the initial state is restored
' Remove existing filters for pivot field
oPivotField.EnableMultiplePageItems = True
oPivotField.ClearAllFilters
' Store current field format
sFmt = oPivotField.NumberFormat
' Change format to compare Long type values and avoid date formats regional mess
oPivotField.NumberFormat = "0"
If IsDate(rFrom) Then
lFrom = CLng(rFrom)
Else
lFrom = 0
End If
If IsDate(rUpto) Then
lUpto = CLng(rUpto)
Else
lUpto = 2958465
End If
' Loop through each page field item and check if at least one item is visible
For Each oPivotItem In oPivotField.PivotItems
bItemVisible = oPivotItem.Value >= lFrom And oPivotItem.Value <= lUpto
If bItemVisible Then Exit For
Next
If bItemVisible Then
' Loop through each page field item and switch visibility
For Each oPivotItem In oPivotField.PivotItems
oPivotItem.Visible = oPivotItem.Value >= lFrom And oPivotItem.Value <= lUpto
Next
Else
MsgBox "There is no data to show for range you set", vbInformation
End If
' Restore initial state
oPivotField.NumberFormat = sFmt
Application.EnableEvents = True
Application.ScreenUpdating = True
On Error GoTo 0
ActiveSheet.PivotTables("ItemsSold").RefreshTable
' Check if field located in Row or Column Labels area
Case xlColumnField, xlRowField
Set cPivotFilters = oPivotField.PivotFilters
' Prepare for update
Application.EnableEvents = False
Application.ScreenUpdating = False
On Error Resume Next ' to be sure the initial state is restored
' Remove existing date filters for pivot field
Set cPivotFilters = ActiveSheet.PivotTables("ItemsSold").PivotFields("Date Sold").PivotFilters
For Each oFilter In cPivotFilters
If _
oFilter.FilterType = xlDateBetween Or _
oFilter.FilterType = xlBefore Or _
oFilter.FilterType = xlAfter Then _
oFilter.Delete
Next
' Add new filter regarding of set range
Select Case True
Case IsDate(rFrom) And IsDate(rUpto)
cPivotFilters.Add Type:=xlDateBetween, Value1:=CDbl(rFrom), Value2:=CDbl(rUpto)
Case IsDate(rFrom)
cPivotFilters.Add Type:=xlAfter, Value1:=CDbl(rFrom)
Case IsDate(rUpto)
cPivotFilters.Add Type:=xlBefore, Value1:=CDbl(rUpto)
End Select
' Restore initial state
Application.EnableEvents = True
Application.ScreenUpdating = True
On Error GoTo 0
ActiveSheet.PivotTables("ItemsSold").RefreshTable
Case Else
MsgBox "The field should be located in Row or Column Labels area, or Report Filter area", vbInformation
End Select
End If
End Sub
推荐阅读
- node.js - ffmpeg和s3之间的标题冲突
- ruby-on-rails - 安装 ruby gems 时出错(由于某种原因无法创建 Makefile,可能缺少必要的库和/或头文件。)
- react-native - 错误无法解析清单资产。图标可能不起作用。无法在博览会中执行缓存刷新?
- sql - SQL中的整数到字符串
- python - Informatica 服务器(托管在 NTTData 上的共享网络)与 Google Cloud Storage 的 Pythonic 连接
- java - 如何使用 Postgres JSON?jdbcTemplate 中的运算符?
- c++ - 打开高级选项时 QPrintDialog 崩溃
- javascript - 计算从 url 参数 React 获得的值 count
- swift - SwiftUI+Combine - 动态订阅发布者的字典
- flutter - 使用 Flutter 命名路由的 FadeTransition