求教：数据透视表的问题（急待）

rsfzcs

这是我录制的数据透视表的过程宏，可当运行时提示：运行错误1004，类PivotTable的 AddFileds 方法无效。我的目的是建立一个运行宏按钮，在多个相同格式的工作表中快速建立数据透视表。因各个源工作表的名称不一样，那红色字体处是否应该有所改动，应该怎样改呢？

请诸位老师指教！

ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _ "华北!C1:C8").CreatePivotTable TableDestination:="", TableName:="数据透视表1" ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1) ActiveSheet.Cells(3, 1).Select ActiveSheet.PivotTables("数据透视表1").SmallGrid = False ActiveSheet.PivotTables("数据透视表1").AddFields RowFields:=Array("省份", "姓名"), _ ColumnFields:="费用项目", PageFields:="月份" With ActiveSheet.PivotTables("数据透视表1").PivotFields("金额") .Orientation = xlDataField .Caption = "求和项:金额" .Function = xlSum End With With ActiveSheet.PivotTables("数据透视表1").PivotFields("费用项目") .PivotItems("（空白）").Visible = False End With With ActiveSheet.PivotTables("数据透视表1").PivotFields("省份") .PivotItems("（空白）").Visible = False End With With ActiveSheet.PivotTables("数据透视表1").PivotFields("姓名") .PivotItems("（空白）").Visible = False End With ActiveWindow.SmallScroll Down:=-9 End Sub

rsfzcs

名称改动不了没事，关键是为何宏运行不了！

FENGJUN

按照你的需求，那红色字体处肯定应该有改动

请看实例：动态更改源数据表创建透视表.xls，代码不够简练。

Private Sub CommandButton1_Click()

sht = ListBox1.Value

Select Case sht Case Is = "Sheet1" sc = Sheets("sheet1").Range("C1:C8").Address '判断工作簿中是否存在同名透视表 'On Error Resume Next For j = 1 To ThisWorkbook.Sheets.Count On Error Resume Next For i = 1 To Sheets(j).PivotTables.Count If Sheets(j).PivotTables(i).Name = "数据透视表1" Then Sheets(j).Delete ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=sc).CreatePivotTable TableDestination:="", TableName:= _ "数据透视表1", DefaultVersion:=xlPivotTableVersion10 ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1) End If Next Next

ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=sc).CreatePivotTable TableDestination:="", TableName:= _ "数据透视表1", DefaultVersion:=xlPivotTableVersion10 ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1) Exit Sub

Case Is = "Sheet2" sc = Sheets("sheet2").Range("C1:C8").Address '判断工作簿中是否存在同名透视表 'On Error Resume Next For j = 1 To ThisWorkbook.Sheets.Count On Error Resume Next For i = 1 To Sheets(j).PivotTables.Count If Sheets(j).PivotTables(i).Name = "数据透视表2" Then Sheets(j).Delete ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=sc).CreatePivotTable TableDestination:="", TableName:= _ "数据透视表2", DefaultVersion:=xlPivotTableVersion10 ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)

End If Next Next

ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=sc).CreatePivotTable TableDestination:="", TableName:= _ "数据透视表2", DefaultVersion:=xlPivotTableVersion10 ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)

Exit Sub

Case Is = "Sheet3" sc = Sheets("sheet3").Range("C1:C8").Address '判断工作簿中是否存在同名透视表 'On Error Resume Next For j = 1 To ThisWorkbook.Sheets.Count On Error Resume Next For i = 1 To Sheets(j).PivotTables.Count If Sheets(j).PivotTables(i).Name = "数据透视表3" Then Sheets(j).Delete ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=sc).CreatePivotTable TableDestination:="", TableName:= _ "数据透视表3", DefaultVersion:=xlPivotTableVersion10 ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1) End If Next Next

ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=sc).CreatePivotTable TableDestination:="", TableName:= _ "数据透视表3", DefaultVersion:=xlPivotTableVersion10 ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1) Exit Sub

End Select

End Sub

Pd59HqK8.rar (15.91 KB, 下载次数: 34)

2004-6-24 12:00 上传

点击文件名下载附件

[此贴子已经被作者于2004-6-24 12:00:43编辑过]

rsfzcs

谢谢4楼老师！

运行时有错误：找到未命名参数！

兰色幻想

好象名称改动不了

CXLX

问题出在SourceData:= _ "华北!C1:C8"。
将“C1:C8”改为数据源的在列区域，如“C1:F8”或“C:F”。
试试吧。