将数据透视表添加到包含同一工作表中数据的新工作表

时间:2018-03-24 21:18:52

标签: excel vba excel-vba pivot-table

我的代码根据以下代码创建了一个新工作表ws2,其中我有一个从ws1中提取的表格。我想将一个数据透视表放在单元格中的同一张ws2" L4"根据代码的底部部分,但它不起作用。

Sub ClickThisMacro()

Dim i As Long
Dim y As Long
Dim n As Long

Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Report")

Dim ws2 As Worksheet: Set ws2 = Sheets.Add

Set rng1 = ws1.Range("A:A").Find("Name")

fr = rng1.Row
lr = ws1.Range("B" & Rows.Count).End(xlUp).Row
y = 2

For i = fr + 1 To lr
    ws2.Cells(y, 1) = ws1.Cells(i, 1)
    ws2.Cells(y, 2) = ws1.Cells(i, 2)
    ws2.Cells(y, 3) = ws1.Cells(i, 3)
    ws2.Cells(y, 4) = ws1.Cells(i, 4)
    ws2.Cells(y, 5) = ws1.Cells(i, 18)

    y = y + 1
Next i

ws2.Cells(1, 1) = "Cost centre name"
ws2.Cells(1, 2) = "Cost centre code"
ws2.Cells(1, 3) = "Phone number"
ws2.Cells(1, 4) = "User name"
ws2.Cells(1, 5) = "Amount"

LastRow = ws2.Range("A1").End(xlDown).Row

' making columns C and F numbers
ws2.Range("C2:C" & LastRow).Select

For Each xCell In Selection
    xCell.Value = xCell.Value
Next xCell

With ws2.UsedRange.Columns(5)
    .Replace "£", "", xlPart
    .NumberFormat = "#,##0.00"
    .Formula = .Value
End With

With ws2.UsedRange.Columns(8)
    .Replace "£", "", xlPart
    .NumberFormat = "#,##0.00"
    .Formula = .Value
End With

'Pivot table
Dim mypivot As PivotTable
Dim mycache As PivotCache

Set mycache = ws2.PivotCaches.Create(xlDatabase, Range("a1").CurrentRegion)

Set mypivot = ws2.PivotTables.Add(mycache.Range("l4"), "Mypivot1")

mypivot.PivotFields("Cost centre name").Orientation = xlRowField
mypivot.PivotFields("Cost centre code").Orientation = xlColumnField
mypivot.PivotFields("Amount").Orientation = xlDataField

End Sub

1 个答案:

答案 0 :(得分:1)

您在设置PivotCachePivotTable对象的部分的代码中存在一些语法错误。

修改后的代码 (数据透视表部分)

' set the Pivot-Cache
Set mycache = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=ws2.Range("A1").CurrentRegion.Address(False, False, xlA1, xlExternal))

' set the Pivot-Table object
Set mypivot = ws2.PivotTables.Add(PivotCache:=mycache, TableDestination:=ws2.Range("L4"), TableName:="Mypivot1")

With mypivot
    .PivotFields("Cost centre name").Orientation = xlRowField
    .PivotFields("Cost centre code").Orientation = xlColumnField
    .PivotFields("Amount").Orientation = xlDataField
End With

您应该在代码中添加一些其他修改/建议:

  1. 使用Find你应该处理一个场景(即使不太可能)你找不到你想要的术语,在这种情况下如果Rng1 = Nothing那么fr = Rng1.Row会导致运行时错误。
  2. 处理Find代码:

    Set Rng1 = ws1.Range("A:A").Find("Name")
    If Not Rng1 Is Nothing Then ' confirm Find was successfull
        fr = Rng1.Row
    Else ' if Find fails
        MsgBox "Critical Error, couldn't find 'Name' in column A", vbCritical
        Exit Sub
    End If
    
    1. 您应该避免使用SelectSelection,而是可以使用完全限定的Range对象:
    2. 通过范围循环:

      For Each xCell In ws2.Range("C2:C" & lr)
          xCell.Value = xCell.Value
      Next xCell