将数据透视表总和复制到下一个空单元格。

Question

我有一个位于N,O列的Pivot表，其中有一行总和，我想把总和复制到 "R "列列表中的下一个空单元格中。我找到了一段代码，它可以将总和复制到一个单元格中，但我不能让它复制到下一个空单元格中。

Dim rngPvt As Range, sht As Worksheet, valToFind$, gtv
Set sht = Sheets("Sheet1")
Set rngPvt = sht.PivotTables("1").RowRange
valToFind = sht.PivotTables("1").GrandTotalName
Set gtv = rngPvt.Find(valToFind, , xlFormulas)
'assumes value to the right of field name
Sheets("Sheet1").Cells(LastRow, 18).PasteSpecial xlPasteValues = gtv.Offset(, 1)

Answer 1

试试这个...

Sub test()

Dim wb As Workbook
Set wb = ThisWorkbook
Dim sh As Worksheet
Set sh = wb.Sheets("Sheet1")
Dim pt As PivotTable
Set pt = sh.PivotTables("PivotTable1")
Dim FinalPvtGT As Range
Set FinalPvtGT = pt.TableRange1(pt.TableRange1.Rows.Count, _
                            pt.TableRange1.Columns.Count)
Dim targetCell As Range
Set targetCell = FinalPvtGT.Offset(, 3)

targetCell = FinalPvtGT

End Sub

你是否希望在列R的最后一个填充的单元格后？如果是，那么替换下面的一行

Set targetCell = FinalPvtGT.Offset(, 3)

与

Set targetCell = Range("R" & sh.Rows.Count).End(xlUp).Offset(1, 0)

Answer 2

这是一个代码，也许你可以找出它来实现你的代码。

Sub test()

Set sht = Sheets("Sheet1")
Set pt1 = sht.PivotTables(1)
Set pt2 = sht.PivotTables(2)
Range("E26").Value = pt1.GetPivotData("SUM").Value
Range("B26").Value = pt2.GetPivotData("SUM").Value

End Sub

总数需要复制到R列的下一行空行。

哦......对不起，所以你的问题是复制的GrandTotal的位置:)。

我找到了一个代码，可以把总和复制到一个单元格中，但是...。我无法将其复制到下一个空单元格中。

Sheets("Sheet1").Cells(LastRow, 18).Select

如果你逐步运行上面的代码，活动单元格的结果是否正确？如你所料，活动单元格的结果是下一个空单元格。

如果不正确，那么也许你需要在上面的代码中添加 .offset(1,0) 在...之前 .select. 但我还是不知道你的 "LastRow "变量的值是多少。如果这个值是工作表中最后一行的行号(我的是1048576)，那么也许你需要把 "LastRow "变量的值写成 .end(xlup).offset(1,0)

如果正确的话，不知道问题出在哪里 ?

它也可以用上面的代码来完成。

Sheets("Sheet1").Cells(LastRow, 18).value = pt1.GetPivotData("SUM").Value

"SUM "这个词取决于你的数据透视表GrandTotal列头名称是什么。我的是SUM，如上图所示。

这段代码不取决于数据透视表GrandTotal显示的行。所以你不必在代码中先找到数据透视表GrandTotal的字，然后用offset(0,1)得到值。例如一开始GrandTotal显示在第200行，数据源改变后刷新后GrandTotal显示在第1000行，它总是会给你正确的GrandTotal。

Answer 3

将总和数据透视到指定的单元格

Option Explicit

Sub PivotGrandTotal()

    Const SheetName As String = "Sheet1"
    Const writeColumn As Long = 18

    Dim rng As Range          ' PivotTable's RowRange, Last Non-Empty Cell
    Dim findString As String  ' PivotTable's GrandTotalName
    ' If certain that whole number, then use "As Long" in the following line.
    Dim gTotal As Double      ' Grand Total Value
    Dim FER As Long           ' Write Row (First Empty Row)

    With ThisWorkbook.Worksheets(SheetName)
        ' Retrieve Grand Total.
        With .PivotTables(1)
            findString = .GrandTotalName
            Set rng = .RowRange
        End With
        gTotal = rng.Find(findString, , xlFormulas).Offset(, 1).Value
        ' Define writeRow.
        Set rng = .Columns(writeColumn).Find("*", , xlFormulas, , , xlPrevious)
        If Not rng Is Nothing Then FER = rng.Row + 1 Else FER = 1
        ' Write to writeCell.
        .Cells(FER, writeColumn).Value = gTotal
    End With

End Sub