在for循环vba中创建数据透视表

时间:2016-07-11 17:38:34

标签: excel-vba vba excel

我有一张70多张的工作簿。每个工作表都已创建并命名,我使用过滤器将相应的数据放入工作表中。数据范围有可能每周都在变化。我编写了一个vba程序来执行所有操作,但使用唯一的筛选数据在每个工作表中创建数据透视表。 我的问题是,如何在for循环内的每个工作表中创建一个数据透视表?我已经推断下面代码中的问题是代码中的源数据部分。 每个选项卡的数据范围将不同(列保持不变但行数不同)。 在循环中迭代时,是否还需要重命名数据透视表?

Sub Ptloop()

dim x as long
dim SorceRange as Range
dim k as long
'start of first generated work sheet
x=4
'number of worksheets
k=75


Set SourceRange = Range("A4", ActiveCell.End(xlDown).End(xlToRight))

For Each Worksheet In ActiveWorkbook.Sheets
If x <= k Then

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
   Sheets(x).SourceRange, Version:=xlPivotTableVersion14). _
    CreatePivotTable TableDestination:=Sheets(x).Cells(4, 21), TableName:="PivotTable3", DefaultVersion _
   :=xlPivotTableVersion14
 x = x + 1
Else
Exit For
End If
Next Worksheet
End Sub

1 个答案:

答案 0 :(得分:0)

There are few things that may be throwing the code off, or have the potential too.

Please see the refactored code below for a cleaner, easier to maintain program.

Option Explicit 'this forces variable declaration and is a "must use" programming tool

Sub Ptloop()

Dim ws as Worksheet 'make sure to qualify the worksheet to a variable
                      'using `Worksheet` could be problematic since its a reserved word in Excel for the `Worksheet` object itself

Dim SourceRange as Range

For Each ws In ThisWorkbook.Worksheets 'if you have a chart or macro sheet in your workbook `Sheets` will produce an error, if you only need actual Worksheets, use that directly

    If ws.Index > 3 Then 'use the index property, you only want worksheets after sheet 3

       With ws 'work directly with the object and assignment parentage to all objects

           'set the range inside the loop to capture the data for that specific sheet
           Set SourceRange = .Range("A4", .Range("A4").End(xlDown).End(xlToRight))

           'ActiveWorkbook may or may not refer to the workbook you really want to work with .. ThisWorkbook refers to the book running the code
           ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=SourceRange, Version:=xlPivotTableVersion14). _
               CreatePivotTable TableDestination:=.Cells(4, 21), TableName:="PivotTable" & ws.Index, DefaultVersion _
               :=xlPivotTableVersion14

       End With

   End If

Next ws

End Sub