VBA 将度量添加到 PowerPivot 数据透视表答案

【问题标题】：VBA to Add Measure to PowerPivot Pivot TableVBA 将度量添加到 PowerPivot 数据透视表
【发布时间】：2017-03-01 12:21:20
【问题描述】：

更新：我想我找到了答案，但我无法查看在 Excel 2013 中是否有办法做到这一点。

https://msdn.microsoft.com/en-us/library/office/mt574976.aspx

该链接包含有关 ModelMeasures.Add 方法的文档，但我现在无法找到真正出色的示例。如果有人有一个很好的例子，可以在 Excel 2013 中使用 VBA 向模型添加度量，请分享作为答案。

我能找到但无法在 Excel 2013 中完成的最佳示例： https://social.msdn.microsoft.com/Forums/en-US/c7d5f69d-b8e3-4823-bbde-61253b64b80e/vba-powerpivot-object-model-adding-measures-with-modelmeasuresadd?forum=isvvba

原帖：

我正在尝试使用 VBA 自动将计算字段添加到 powerpivot 数据透视表。我对 VBA 没有经验。

当我使用以下公式手动添加计算字段时，我可以看到添加的计算字段。这个 VBA 代码有什么问题？

这是我的代码：

Sub Macro5()
Dim PvtTbl As PivotTable
Set PvtTbl = Worksheets("Sheet4").PivotTables("PivotTable6")

'Table1 is part of the PowerPivot data model and I have created a pivot table from Table1
PvtTbl.CalculatedFields.Add "column", "=IF(HASONEVALUE(Table1[TEXT1]), VALUES(Table1[TEXT1]), BLANK())"

'Selecting the pivot table and adding the new calculated field
    Range("D7").Select
    ActiveSheet.PivotTables("PivotTable6").AddDataField ActiveSheet.PivotTables( _
        "PivotTable6").CubeFields("[Measures].[column]")
End Sub

我得到的错误：

运行时错误“1004”：应用程序定义或对象定义错误

【问题讨论】：

标签： vba excel excel-2013

【解决方案1】：

将其组合在一起以从 Excel 工作表加载（需要更改范围等）将覆盖现有度量的公式，因此可以迭代并且不必处理错误消息（除了最后一个错误处理程序）。

最好的部分是可以不按顺序加载度量，以便可以加载依赖于另一个度量的度量。

Sub AddMeasures()
Dim Mdl As Model
Dim tbl As ModelTable
Set Mdl = ActiveWorkbook.Model
Set tbl = Mdl.ModelTables(1)
Dim rng As Range
Set rng = Worksheets("Sheet2").Range("A2:A75")

Dim measure_name As String
Dim measure_formula As String

Dim cell As Range
Dim item As Integer

For Each cell In rng
    measure_name = cell.Value
    measure_formula = cell.Offset(0, 1).Value
    item = GetItemNumber(measure_name)
    If item > 0 Then
        Mdl.ModelMeasures.item(item).formula = measure_formula  'replace the existing formula
    Else
        On Error GoTo errhandler
        If cell.Offset(0, 2).Value = 1 Then
            Mdl.ModelMeasures.Add measure_name, tbl, measure_formula, Mdl.ModelFormatWholeNumber(1)
        Else
            Mdl.ModelMeasures.Add measure_name, tbl, measure_formula, Mdl.ModelFormatPercentageNumber(False, 1)
        End If
    End If
Next cell

errhandler:
    Debug.Print cell.Address, "Now we have a real problem"
End Sub

Function GetItemNumber(measure_name As String) As Integer
Dim cnt As Integer
Dim Mdl As Model
Dim tbl As ModelTable
Set Mdl = ActiveWorkbook.Model
Set tbl = Mdl.ModelTables(1)

For cnt = 1 To Mdl.ModelMeasures.Count
    If Mdl.ModelMeasures.item(cnt).Name = measure_name Then
        Debug.Print "Have a duplicate measure name"
        Exit For
    End If
Next cnt

If cnt > 0 And cnt <= Mdl.ModelMeasures.Count Then
    GetItemNumber = cnt
Else
    GetItemNumber = 0
End If
End Function

【讨论】：