VBA中范围内的数据透视图数据标签答案

【问题标题】：PivotChart Data Labels from Range in VBAVBA中范围内的数据透视图数据标签
【发布时间】：2019-01-24 02:52:12
【问题描述】：

我正在尝试编辑数据透视图，以便在必要时缩小其数据标签（即 6 位数字除以 1,000），这需要将单元格区域中的自定义标签添加到数字中以显示它被缩放了。例如，一个最初为 800,000 的数字将通过自定义公式系列在数据透视表中转换为 800，然后另一个带有公式的单元格将确定它是否已被缩放并显示“M”（英里）如果它有。

我可以在不使用 VBA 的情况下静态完成此操作，只需在格式化数据标签时选中“单元格中的值”框和“值”框即可。但是，更改视图（正如我需要不断做的那样）会重置我在检查“来自单元格的值”时创建的链接。此外，我的标签经常恢复为非粗体且比我制作的更小。因此，我觉得我需要创建一个宏来更新我的数据标签，以包括范围查找和随着表的每次更改而调整大小。为此，我的代码如下。

Dim numSubs As Integer
Dim Labels As Range
numSubs = 7 'find a way to count number of active series
For i = 1 To numSubs
    With Sheet16.ChartObjects("Chart 2").SeriesCollection(i).DataLabels
        .ShowRange = False
        .Format.TextFrame2.TextRange. _
            InsertChartField msoChartFieldRange, "='New PC Mapping'!$I$32:$I$34", 0 'find a way to cycle thru ranges
        .Format.TextFrame2.TextRange.Font.Bold = msoTrue
        .Format.TextFrame2.TextRange.Font.Size = 14
    End With
Next

首先，VBA 告诉我无法在图表上运行 SeriesCollection，这是我读过的所有示例中显示的方法。我不知道症结在哪里。我已经验证它可以识别 Sheet16.ChartObjects("Chart 2")

其次，我需要找到一种方法来循环多个范围，因为每个系列都有自己的。我这里的代码行来自录制一个宏，因为我在网上的任何地方都找不到执行此操作的代码，所以我确信它可以改进，但在当前的形式中，它采用的是一个公式字符串，这使得它变得困难例如，使用 Range.Offset 移动。

从那里，我知道如何在处理数据透视表时触发它。我只需要一些帮助才能让它在一个系列上工作，我可以从那里进行概括。谢谢！

【问题讨论】：

当您说循环多个范围时，您所说的范围是什么。如果只是打开工作表并查看...，您将如何识别/区分它们？
问题 1 的答案是 SeriesCollection 是 [Chart or Chart group][1] 的成员。将Sheet16.ChartObjects("Chart 2").SeriesCollection(i).DataLabels 更改为Sheet16.ChartObjects("Chart 2").Chart.SeriesCollection(i).DataLabels 应该会给你想要的结果。 [1]：docs.microsoft.com/en-us/office/vba/api/excel.seriescollection
成功了，谢谢！我有一个矩阵，其中每个系列都应该映射到一列 3 个值。我正在修改此代码：~~~ Set dataLabelRange = Sheet24.Range("I32:I34").Offset(0, i) Set dataLabelFormula = "=" & CStr(dataLabelRange) 并让 dataLabelFormula 替换“=” New PC Mapping'!... 行，但仍然出现错误

标签： excel vba

【解决方案1】：

感谢 cmets 的帮助，克里斯！

我发现了一种方法来执行我需要的循环：

Set dataLabelRange = Sheet24.Range("I20:I22").Offset(0, i)
dataLabelString = "='New PC Mapping'!" & dataLabelRange.Address

使用 i++，每个循环和 dataLabelString 都插入到地址上方。

对于需要在宏中重新链接地址的任何人，例如通过单击可能会切断这些链接的数据透视表触发，我的最终代码如下：

Dim dataLabelRange As Range
Dim dataLabelString As String
Dim mySeries As Series
Dim i As Integer
i = 0
For Each mySeries In Sheet16.ChartObjects("Chart 1").Chart.FullSeriesCollection
    Set dataLabelRange = Sheet24.Range("I20:I22").Offset(0, i) 'runs through columns of 3 side by side, which is how I had the labels I wanted to add
    dataLabelString = "='*Sheet Name*'!" & dataLabelRange.Address
    mySeries.ApplyDataLabels
    With mySeries.DataLabels
        .ShowRange = False
        .Format.TextFrame2.TextRange.InsertChartField msoChartFieldRange, dataLabelString, 0
        .ShowRange = True
        .Format.TextFrame2.TextRange.Font.Bold = msoTrue 'addition code for formatting labels
        .Format.TextFrame2.TextRange.Font.Size = 14
        .Separator = " "
    End With
    i = i + 1
Next mySeries

【讨论】：