数据透视表:检测数据透视字段何时折叠

2024-04-24

对于数据透视表中显示的数据,我选择对数据表的某些部分应用条件格式以突出显示某些范围内的值。弄清楚如何以不同于小计数据的方式突出显示第二级行数据很有趣,但我能够解决它。我的 VBA 使用以下命令触发Worksheet_PivotTableUpdate事件,以便每当用户更改数据透视表字段时,条件格式都会相应更新。

当某些部分折叠时,此方法仍然有效:

当所有顶级部分都折叠时,会发生运行时错误,因此不会显示第二级行数据(位置=2)。

我收到以下错误:

我一直在寻找一种方法来检测所有第二个位置行字段是否已折叠/隐藏/不可见/未钻孔,以便识别该条件并跳过格式化部分。但是,我还没有发现 a 的哪种方法或属性PivotField, PivotItem, or PivotTable会给我这些信息。

直接附加到工作表的事件代码是

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
    ColorizeData
End Sub

所以在一个单独的模块中,代码为ColorizeData is

Option Explicit

Sub ColorizeData()
    Dim staffingTable As PivotTable
    Dim data As Range
    Set staffingTable = ActiveSheet.PivotTables(PIVOT_TABLE_NAME)
    Set data = staffingTable.DataBodyRange
    '--- don't select the bottom TOTALS row, we don't want it colored
    Set data = data.Resize(data.rows.count - 1)

    '--- ALWAYS clear all the conditional formatting before adding
    '    or changing it. otherwise you end up with lots of repeated
    '    formats and conflicting rules
    ThisWorkbook.Sheets(PIVOT_SHEET_NAME).Cells.FormatConditions.Delete
    ThisWorkbook.Sheets(PIVOT_SHEET_NAME).Cells.ClearFormats
    staffingTable.DataBodyRange.Cells.NumberFormat = "#0.00"
    staffingTable.ColumnRange.NumberFormat = "mmm-yyyy"

    '--- the cell linked to the checkbox on the pivot sheet is
    '    supposed to be covered (and hidden) by the checkbox itself
    If Not ThisWorkbook.Sheets(PIVOT_SHEET_NAME).Range("D2") Then
        '--- we've already cleared it, so we're done
        Exit Sub
    End If

    '--- capture the active cell so we can re-select it after we're done
    Dim previouslySelected As Range
    Set previouslySelected = ActiveCell

    '--- colorizing will be based on the type of data being shown.
    '    Many times there will be multiple data sets shown as sums in
    '    the data area. the conditional formatting by FTEs only makes
    '    sense if we colorize the Resource or TaskName fields
    '    most of the other fields will be shown as summary lines
    '    (subtotals) so those will just get a simple and consistent
    '    color scheme

    Dim field As PivotField
    For Each field In staffingTable.PivotFields
        Select Case field.Caption
        Case "Project"
            If field.Orientation = xlRowField Then
                If field.Position = 1 Then
                    staffingTable.PivotSelect field.Caption, xlFirstRow, True
                    ColorizeDataRange Selection, RGB(47, 117, 181), RGB(255, 255, 255)
                End If
            End If
        Case "WorkCenter"
            If field.Orientation = xlRowField Then
                If field.Position = 1 Then
                    staffingTable.PivotSelect field.Caption, xlFirstRow, True
                    ColorizeDataRange Selection, RGB(155, 194, 230), RGB(0, 0, 0)
                End If
            End If
        Case "Resource"
            If field.Orientation = xlRowField Then
                If field.Position = 1 Then
                    staffingTable.PivotSelect field.Caption, xlFirstRow, True
                Else
===> ERROR HERE-->  staffingTable.PivotSelect field.Caption, xlDataOnly, True
                End If
                ColorizeConditionally Selection
            End If
        Case "TaskName"
            If field.Orientation = xlRowField Then
                If field.Position = 1 Then
                    staffingTable.PivotSelect field.Caption, xlFirstRow, True
                Else
                    staffingTable.PivotSelect field.Caption, xlDataOnly, True
                End If
                ColorizeConditionally Selection
            End If
        End Select
    Next field

    '--- re-select the original cell so it looks the same as before
    previouslySelected.Select
End Sub

表的具体设置是当用户选择行数据为

以防万一您想知道,为了完整性起见,我在此处包含了两个私有子调用:

Private Sub ColorizeDataRange(ByRef data As Range, _
                              ByRef interiorColor As Variant, _
                              ByRef fontColor As Variant)
    data.interior.Color = interiorColor
    data.Font.Color = fontColor
End Sub

Private Sub ColorizeConditionally(ByRef data As Range)
    '--- light green for part time FTEs
    Dim dataCondition As FormatCondition
    Set dataCondition = data.FormatConditions.Add(Type:=xlCellValue, _
                                                  Operator:=xlBetween, _
                                                  Formula1:="=0.1", _
                                                  Formula2:="=0.5")
    With dataCondition
        .Font.ThemeColor = xlThemeColorLight1
        .Font.TintAndShade = 0
        .interior.PatternColorIndex = xlAutomatic
        .interior.ThemeColor = xlThemeColorAccent6
        .interior.TintAndShade = 0.799981688894314
        .SetFirstPriority
        .StopIfTrue = False
    End With

    '--- solid green for full time FTEs
    Set dataCondition = data.FormatConditions.Add(Type:=xlCellValue, _
                                                  Operator:=xlBetween, _
                                                  Formula1:="=0.51", _
                                                  Formula2:="=1.2")
    With dataCondition
        .Font.ThemeColor = xlThemeColorLight1
        .Font.TintAndShade = 0
        .Font.Color = RGB(0, 0, 0)
        .interior.PatternColorIndex = xlAutomatic
        .interior.Color = 5296274
        .SetFirstPriority
        .StopIfTrue = False
    End With

    '--- orange for slightly over full time FTEs
    Set dataCondition = data.FormatConditions.Add(Type:=xlCellValue, _
                                                  Operator:=xlBetween, _
                                                  Formula1:="=1.2", _
                                                  Formula2:="=1.85")
    With dataCondition
        .Font.Color = RGB(0, 0, 0)
        .Font.TintAndShade = 0
        .interior.PatternColorIndex = xlAutomatic
        .interior.Color = RGB(255, 192, 0)
        .SetFirstPriority
        .StopIfTrue = False
    End With

    '--- red for way over full time FTEs
    Set dataCondition = data.FormatConditions.Add(Type:=xlCellValue, _
                                                  Operator:=xlGreater, _
                                                  Formula1:="=1.85")
    With dataCondition
        .Font.Color = RGB(255, 255, 255)
        .Font.TintAndShade = 0
        .interior.PatternColorIndex = xlAutomatic
        .interior.Color = RGB(255, 0, 0)
        .SetFirstPriority
        .StopIfTrue = False
    End With
End Sub

EDIT:感谢@ScottHoltzman,我将他的检查与下面的逻辑结合起来并得出了一个解决方案

    Case "Resource"
        If field.Orientation = xlRowField Then
            If (field.Position = 2) And PivotItemsShown(staffingTable.PivotFields("Project")) Then
                staffingTable.PivotSelect field.Caption, xlDataOnly, True
                ColorizeConditionally Selection
            ElseIf field.Position = 1 Then
                staffingTable.PivotSelect field.Caption, xlFirstRow, True
                ColorizeConditionally Selection
            End If
        End If

Use the ShowDetail的方法PivotItems目的。我包装成一个函数,以便更清晰地集成到您的代码中。所有这些都是因为您必须测试该领域的每一项。

测试代码:

If field.Orientation = xlRowField Then
    If PivotItemsShown(field) Then
        If field.Position = 1 Then
            staffingTable.PivotSelect field.Caption, xlFirstRow, True
        Else
            staffingTable.PivotSelect field.Caption, xlDataOnly, True
        End If
        ColorizeConditionally Selection
    End If
End If

Function PivotItemShown(pf as PivotField) as Boolean

    Dim pi as PivotItem

    For each pi in pf.PivotItems
        If pi.ShowDetail Then 
            PivotItemsShown = True
            Exit For
        End If
    Next

End Function

更新:下面的两个黑客方法

既然您知道,在您的示例中,如果所有 3 个项目都折叠,单元格 A10 将为空白,您可以像这样检查:

If Len(Range("A10") Then ... `skip this section

或者,如果您随时可能有动态项目列表,请使用以下命令:

For each rng in Range(Range("A6"),Range("A6").End(xlDown))
    If Instr(rng.Value,"Project") = 0 and rng.Value <> "Grand Total" Then 
        '.... select the row range as needed
        Exit For
    End If
Next 
本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)

数据透视表:检测数据透视字段何时折叠 的相关文章

  • Range.End() 困惑

    我有一个关于 VBA 中 Range End 属性的一般性问题 我已经阅读了有关该房产的信息here http msdn microsoft com en us library bb221181 aspx 但我还是很困惑 例子 With w
  • 使用 Cucumber Scenario Outline 处理 Excel 电子表格

    如果可能的话 我试图找到一种更优雅的方法来处理从与 Excel 电子表格行 第 n 个 相关的 Cucumber Scenario Outline 中调用第 n 个数字 目前 我正在使用迭代编号来定义要从中提取数据的 Excel 电子表格的
  • 强力查询历年产品利润对比

    我有一个数据集 其中包含公司 产品 利润和年份 公司每年都会销售少量产品并获得利润 公司没有必要在明年销售相同的产品 他们可能会省略以前的产品并添加新的少量产品 我只想对两年的产品进行逐个比较 如下所示 我的数据集是 Company Pro
  • 是否有非 VBA Excel 溢出公式来创建和处理数组数组?

    我在 Excel 365 中有一张工作表 其中包含 A 列和 B 列 如下所示 我想使用一些公式 不是 VBA 获取 C 列和 D 列 也就是说 我想重复每一个Title for Count次并为其添加一个流水号 A B C D 1 Tit
  • 如果 FIND 函数在 vba 中找不到任何内容,那么[重复]

    这个问题在这里已经有答案了 我目前正在自动化执行以下步骤的手动流程 1 提示用户打开一个数据文件并打开文件 2 插入4列 3 使用文件中已有的数据创建格式为 DD MM YYYY TEXT 的唯一字符串 其中文本是变量 4 使用 if 语句
  • 运行时错误“1004”:对象“_Global”的方法“Range”失败

    我在使用 Excel 时遇到问题 有一个生成参考号的表单 但是当我尝试生成参考号时 它有一条错误消息 运行时错误 1004 对象 Global 的方法 Range 失败 当我点击 调试 按钮时 它显示的代码如下 它突出显示代码第 4 行的错
  • 通过 PHP 检测 excel .xlsx 文件 mimetype

    我无法通过 PHP 检测 xlsx Excel 文件的 mimetype 因为它是 zip 存档 文件实用程序 file file xlsx file xlsx Zip archive data at least v2 0 to extra
  • 如何处理 Workbook.SaveAs 覆盖确认上的“否”或“取消”?

    我希望在 VBA 脚本开始修改内容之前提示用户保存工作簿 当 另存为 对话框出现时 如果用户单击 取消 我会引发自定义错误并停止脚本 如果他们单击 保存 并且文件名已存在 我希望询问他们是否覆盖 这是我的代码 Function SaveCu
  • Excel 宏与 Javascript

    我希望使用 Javascript 中的宏而不是默认的 VBA 来操作 Excel 电子表格 我可以使用以下 VBA 代码执行 javascript 代码 javascript to execute Dim b As String b fun
  • 在 VBA 中使用 getElementsByClassName

    我正在使用此代码从页面获取产品名称 页面代码是 div class product shop col sm 7 div class product name h1 Claro Glass 1 5 L Rectangular Air Tigh
  • 将 Python Selenium 输出写入 Excel

    我编写了一个脚本来从在线网站上抓取产品信息 目标是将这些信息写入 Excel 文件 由于我的Python知识有限 我只知道如何在Powershell中使用Out file导出 但结果是每个产品的信息都打印在不同的行上 我希望每种产品都有一条
  • java实现excel价格、收益率函数[关闭]

    就目前情况而言 这个问题不太适合我们的问答形式 我们希望答案得到事实 参考资料或专业知识的支持 但这个问题可能会引发辩论 争论 民意调查或扩展讨论 如果您觉得这个问题可以改进并可能重新开放 访问帮助中心 help reopen questi
  • 选择在 Excel 宏(VBA 中的范围对象)中具有值的列

    如何修改 VBA 中的这一行以仅选择具有值的列 Set rng Range A1 Range A65536 End xlUp SpecialCells xlCellTypeVisible 我不认为我做的事情是正确的CountLarge财产是
  • 在 VBA 中按键对字典进行排序

    我使用 VBA 创建了一个字典CreateObject Scripting Dictionary 将源单词映射到要在某些文本中替换的目标单词 这实际上是为了混淆 不幸的是 当我按照下面的代码进行实际替换时 它将按照源单词添加到字典中的顺序替
  • 将表行从 Word 文档复制到现有文档表特定单元格

    我正在寻找一个宏 它将内容从一个 Word 文档中的表格复制到另一个现有 Word 文档中的表格到特定单元格中 从第 5 行开始 复制后面的所有行并将其粘贴到现有文档中的第 5 行 这可能吗 在此输入图像描述 https i stack i
  • 如何使用 Excel Interop 获取筛选行的范围?

    我正在为我的项目使用 Excel Interop 程序集 如果我想使用自动过滤器 那么可以使用 sheet UsedRange AutoFilter 1 SheetNames 1 Microsoft Office Interop Excel
  • OpenArgs 为空问题

    我正在使用OpenArgs使用时发送值的参数DoCmd OpenForm DoCmd OpenForm frmSetOther acNormal acFormAdd acDialog value 然后我用Me OpenArgs在打开的表格内
  • Excel VBA 过滤和复制粘贴数据

    给定一个数据集 假设有 10 列 在 A 列中我有日期 在 B 列中我有 我想仅过滤 A 列 2014 年的数据 B 列 ActiveSheet Range A 1 AR 1617 AutoFilter Field 5 Operator x
  • 字典、集合和数组的比较

    我正在尝试找出字典与集合和数组相比的相对优点和功能 我发现了一篇很棒的文章here http www experts exchange com articles 3391 Using the Dictionary Class in VBA
  • Confluence:使用 VBA 更新现有页面

    我尝试使用 VBA 更新 Confluence 页面 我的想法是使用REST API加载页面内容 修改内容然后上传修改后的版本 这是我的代码 Private Sub TestRESTApi Dim uname As String uname

随机推荐

  • MongoDB 将所有现有索引迁移到新数据库

    我有一个 MongoDB 开发集群 随着时间的推移 我在其中创建索引 作为开发改进的一部分 在测试 生产 MongoDB 集群上 我也想维护相同的索引 那么我如何获取现有集合的所有索引并在新数据库上创建相同的集合索引 从 mongo she
  • 在 Access 2007 中使用 ADO 或 DAO 哪个更好?

    在Access 2007中创建新数据库时 应该使用ADO ActiveX数据对象 还是DAO 数据访问对象 编辑 该数据库的一部分将从 Excel 2007 电子表格导入数据 郑重声明 曾经的 Jet 的正式名称现在是 Access 数据库
  • magento从产品sku获取产品类型

    我如何使用产品 sku 或 id 获取产品类型 简单 可配置 分组 我已加载产品集合并从中尝试通过 product gt getTypeId 但它不打印产品类型 请帮我 Thanks I think product gt getTypeId
  • ANTLR 嵌套函数

    ANTLR 适合这个项目吗 我正在寻找处理和转换用户输入的字符串 其中可能包含自定义函数 例如 用户可能会在字符串中写入类似 CAPITALIZE word 的内容 而我想执行 使用 StringUtils 在后台进行实际转换 我想用户有时
  • 查询返回的结果多于预期

    请耐心等待 这并不是我真正的问题 只是想让别人理解 作者注 The 可能重复 https stackoverflow com questions 4966203 mongo query question gt lt问题解决方案允许 elem
  • ggplot 中十分位数的低、中高颜色

    我想使用 ggplot 绘制多边形类型的空间图 其中绘制多边形 多边形的颜色由其权重决定 示例数据框看起来像 这是数据文件完整的数据文件 https dl dropboxusercontent com u 55346033 sampleDa
  • Gmail 邮件可以通过 API 存档吗?

    似乎无法使用 API 来存档邮件 在 Web 界面中归档涉及moving 而不是labeling发送至 所有邮件 的消息 API 不仅没有列出 所有邮件 标签 而且move也失踪了 只有modify这仅允许在消息中添加或删除标签 这很奇怪
  • 保护 Azure 云服务配置中的敏感信息

    我们正在使用云服务配置 https learn microsoft com en us previous versions azure reference jj156212 v 3Dazure 100 存储应用程序设置 但我们想保护一些应用
  • 电子邮件安全:TLS 和 S/MIME

    我的理解是 TLS 是一种加密技术 允许两个 STMP 服务器安全地相互通信 如果使用 HTTPS 连接到 STMP 服务器 与使用 S MIME 相同吗 不会 TLS 会对通信通道进行加密 S MIME 对消息进行加密 也就是说 这就是
  • System.Web.Security.FormsAuthentication.Encrypt 返回 null

    我正在尝试加密一些 userData 以使用 Forms 身份验证创建我自己的自定义 IPrincipal 和 IIdentity 对象 我已将代表我登录用户的对象序列化为 Json 并创建了我的 FormsAuthentication 票
  • C++:用 istream 包装 vector

    我想包一个vector
  • Eclipse 中的默认导入

    有没有办法自定义 Eclipse 中的默认导入 例如 如果我默认打开一个新的 JUnit 测试类 我会得到以下导入 import static org junit Assert import org junit Test 我想得到什么 im
  • 无法创建“匿名类型”类型的常量值。此上下文中仅支持基本类型或枚举类型

    我对linq和实体框架 我正在尝试解决以下问题为何不起作用的问题 产生的错误是 无法创建 匿名类型 类型的常量值 在此上下文中仅支持原始类型或枚举类型 我已经尝试了很多不同的方法 但仍然收到与原始类型相关的错误 如果有人能看一下下面的代码并
  • 如何让 Maven 发出有关传递依赖版本不匹配的警告?

    在下面的 Maven 依赖项示例中 slf4j 依赖项想要引入 log4j 1 2 17 log4j 显式依赖项想要引入 1 2 15 Maven 将 log4j 解析为版本 1 2 15 但是 Maven 没有打印出 sl4j 需要更高版
  • 通过动画将视图的可见性从消失变为可见

    我有一个观点是invisible默认情况下 只是第一次 现在我需要将可见性切换为VISIBLE有了这个animation if myView getVisibility View INVISIBLE myView setVisibility
  • Http 请求的加载指示器

    我的问题的根源是在 http 请求上显示加载指示器 我想在服务级别上执行此操作 而不必为每个组件编写代码 我所做的是实现一个 http 包装器 它基本上执行以下操作 getMyHttpObservable setLoadingIndicat
  • 具有 Azure Key Vault 的本地 ASP.NET Framework Web 应用程序

    我们正在尝试保护内部 ASP NET Framework Web 应用程序中的应用程序机密 向我提供的最初计划是使用 Azure Key Vault 我开始使用我的 Visual Studio Enterprise 订阅进行开发工作 并且在
  • Laravel,获取当前登录的用户

    我想在应用程序中显示当前登录用户的列表 我想使用 Laravel Auth 方法 我正在查看 API 但找不到类似的东西 我可能需要循环访问会话存储 然后将其与用户 ID 匹配 我对吗 更新 忘了提及 我将会话存储在数据库中 当前登录 是普
  • 为字符串数组分配内存

    我想使用两个函数填充一个字符串数组 第一个 如果我有n个字符串要分配 将分配n个内存空间 第二个将为每个读取的字符串分配内存 这是第一个函数 char allocate int n char t t char malloc n sizeof
  • 数据透视表:检测数据透视字段何时折叠

    对于数据透视表中显示的数据 我选择对数据表的某些部分应用条件格式以突出显示某些范围内的值 弄清楚如何以不同于小计数据的方式突出显示第二级行数据很有趣 但我能够解决它 我的 VBA 使用以下命令触发Worksheet PivotTableUp