为最后更新的行生成数据轴

Question

我有两张床单。Sheet1的“结果”，它有一个包含8列的表。

我有第二个表"Sum“，其中我正在为Reuslt表生成一个数据透视表。

代码运行良好，但它计算每一列的和并给出结果。

我希望只为上一次更新的行提供枢轴表。

最后一次更新行每周更改一次。下周，更新将出现在十七号……

​

​

有人能建议我怎么做吗？任何线索都会有帮助

Sub sum2017()
Dim ws9 As Worksheet
Dim pc9 As PivotCache
Dim pt9 As PivotTable
Dim ct9 As Integer
Set ws9 = Sheets("Sum")
Set pc9 = ActiveWorkbook.PivotCaches.Create(xlDatabase, "'Result'!R1C1:R1048576C6")
Set pt9 = pc9.CreatePivotTable(ws9.Range("A3"))
pt9.AddDataField pt9.PivotFields("NOK"), "Sum of NOK", xlSum
pt9.AddDataField pt9.PivotFields("OK"), "Sum of OK", xlSum
pt9.AddDataField pt9.PivotFields("Total"), "Sum of Total", xlSum
pt9.AddDataField pt9.PivotFields("NOK %"), "Sum of NOK %", xlSum
pt9.AddDataField pt9.PivotFields("OK %"), "Sum of OK %", xlSum
pt9.DataLabelRange.HorizontalAlignment = xlCenter
pt9.DataLabelRange.ReadingOrder = xlContext
pt9.TableRange2.HorizontalAlignment = xlCenter
End Sub

​

​

Answer 1

此代码可以工作，但每次创建新的枢轴时都会添加帮助表。如果您不想这样做，只需添加一些额外的工作表，按您的意愿命名它，而不是将wskHelpSheet的引用更改为该工作表，并记住始终在宏开始时清理此工作表。我希望你听起来很清楚:)

    Sub sum2017()

Dim ws9 As Worksheet
Dim wskResult As Worksheet
Dim pc9 As PivotCache
Dim pt9 As PivotTable
Dim ct9 As Integer
Dim rngPivotRangeHeaders As Range
Dim lngLRow As Long
Dim lngLCol As Long
Dim rngPivotRangeRecords As Range
Dim rngPTRange As Range
Dim wskHelpSheet As Worksheet

    Set ws9 = Sheets("Sum")
    Set wskResult = ThisWorkbook.Sheets("Result")
    Set wskHelpSheet = Worksheets.Add
    With wskResult
        lngLRow = .Cells(Rows.Count, "B").End(xlUp).Row
        lngLCol = .Cells(1, Columns.Count).End(xlToLeft).Column
        Set rngPivotRangeHeaders = .Range(.Cells(1, 1), .Cells(1, lngLCol))
        Set rngPivotRangeRecords = .Range(.Cells(lngLRow, 1), .Cells(lngLRow, lngLCol))
        Set rngPTRange = Union(rngPivotRangeHeaders, rngPivotRangeRecords)
        rngPTRange.Copy
    End With

    With wskHelpSheet
        .Range("a1").PasteSpecial Paste:=xlPasteValues
        lngLRow = .Cells(Rows.Count, "B").End(xlUp).Row
        lngLCol = .Cells(1, Columns.Count).End(xlToLeft).Column
        Set rngPTRange = .Range(.Cells(1, 1), .Cells(lngLRow, lngLCol))
    End With

    Set pc9 = ActiveWorkbook.PivotCaches.Create(xlDatabase, rngPTRange)
    Set pt9 = pc9.CreatePivotTable(ws9.Range("A3"))

    With pt9
        .AddDataField .PivotFields("NOK"), "Sum of NOK", xlSum
        .AddDataField .PivotFields("OK"), "Sum of OK", xlSum
        .AddDataField .PivotFields("Total"), "Sum of Total", xlSum
        .AddDataField .PivotFields("NOK %"), "Sum of NOK %", xlSum
        .AddDataField .PivotFields("OK %"), "Sum of OK %", xlSum
        .DataLabelRange.HorizontalAlignment = xlCenter
        .DataLabelRange.ReadingOrder = xlContext
        .TableRange2.HorizontalAlignment = xlCenter
    End With

End Sub