Question

我创建了一个数据透视表：

ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=Sheets("Working").UsedRange).CreatePivotTable TableDestination:="", TableName:="HDPivotTable", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.Name = "HD Pivot"

ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(1, 1)

ActiveSheet.PivotTables("HDPivotTable").AddFields RowFields:="Location Code"

ActiveSheet.PivotTables("HDPivotTable").PivotFields("h,d,x").Orientation = xlDataField


With ActiveSheet.PivotTables("HDPivotTable").PivotFields("h,d,x")
    .Orientation = xlColumnField

    For i = 1 To .PivotItems.Count
        ' Filter out columns that are not "D" or "H"
        If .PivotItems(i) <> "D" And .PivotItems(i) <> "H" Then
            .PivotItems(i).Visible = False
        End If
    Next      

End With

因此得到的表如下所示：

我需要在Grand Total之后添加一个新列“T / F”，如果列“D”和“H”中的值相等则为TRUE，否则为FALSE。我把它用红色突出显示。无论我尝试什么，我都无法工作。我不是VBA或Excel的专家，所以我只能尝试在互联网上找到的任何东西。你能帮忙吗？

感谢。

Answer 1

如果1或TRUE 0，则会返回FALSE。

ActiveSheet.PivotTables("HDPivotTable").CalculatedFields.Add "Compare", "=Monto ='D/Monto'", True
    'Where:
    'Compare : Is the name of the field (you use "T/F")
    '"=Monto = 'D/Monto'" : Is the comparison of fields you want in your case would be
    '"=D = H" <== that way
ActiveSheet.PivotTables("HDPivotTable").PivotFields("Compare").Orientation = xlDataField
    'Here you add the field to the pivot

编辑＃1 请注意：在第一行中添加一个字段，由于不能是两个具有相同名称的字段，如果运行两次宏，则第一行会出错。

如果您已经创建了字段（“比较”，使用我的示例），则只需将该字段添加到xlDataField即可。

修改2

决定编辑这些问题......

Sub addComp()

    Dim r 'to store the last row
    Dim c 'to store the last column

    c = Application.WorksheetFunction.Match("Grand Total", Range("A3").EntireRow, 0)
        'to find the last column of the pivot
        'in your case would be "Grand Total"
        'if add 1 to c, we get the column next to the pivot
        '
        'In my example, I use my own header, but you can use yours.
        'In your question you use "Grand total", i change it.
        '
        'And that is why you get and error, becuase MATCH was  looking for "Sum of D/Monto",
        'not "Grand total"
    r = Range(Cells(3, c), Cells(3, c)).End(xlDown).Row
        'here I use the 3th row because, in my case my pivot is in the
        '3th row, but you can use the row you want/need
        'that range/row, is the reference that use the pivot to set its position
        'inside the worksheet.
        'And using that row as a reference, whith the code
        'r = Range(Cells(3, c), Cells(3, c)).End(xlDown).Row I just find the last row down
        'no matter how many rows be. Is like, to manually got to the "Grand total" header,
        'press Shift+DownArrow, and you will go to the last row, the code above do the very same.
        '
        'To find the las row of the pivot

    Range(Cells(3, c + 1), Cells(3, c + 1)).Value = "T/F"
        'Here adds the name of our field
    Range(Cells(4, c + 1), Cells(r - 1, c + 1)).FormulaR1C1 = "=RC[-2]=RC[-1]"
        'Here add the TRUE/FALSE to all the cells in the next column of the pivot.
        'I don't use the formula with the Grand total row, but if you want,
        'just remove the " - 1" next to r in the second Cells
End Sub

编辑＃3

Sub addComp()
    Dim r 'to store the last row
    Dim c 'to store the last column
    c = Application.WorksheetFunction.Match("Grand Total", Range("A2").EntireRow, 0)
    r = Range(Cells(2, c), Cells(2, c)).End(xlDown).Row
    Range(Cells(2, c + 1), Cells(2, c + 1)).Value = "T/F"
    Range(Cells(3, c + 1), Cells(r - 1, c + 1)).FormulaR1C1 = "=RC[-2]=RC[-1]"
End Sub

Excel VBA：如何将具有公式的新字段添加到数据透视表？

1 个答案: