Question

我创建数据透视表需要50个以上的文件，每个文件都有相同的具有不同内容的表单。到目前为止，我已经完成了为数据透视表创建的代码，并且在单独运行时效果很好，但是，当我尝试为同一文件夹中的所有工作簿运行代码时，它失败了。我不知道发生了什么，为什么它一直显示没有文件可以找到，尽管路径名没有任何错误。

Sub DoAllFiles()
Dim Filename, Pathname As String
Dim WB As Workbook

Pathname = "D:\Reports"   
Filename = Dir(Pathname & "\*.xls*")
Do While Filename <> ""

Application.DisplayAlerts = False
Application.ScreenUpdating = False
    Set WB = Workbooks.Open(Pathname & Filename)  'open all files
    PivotX WB
    WB.Close SaveChanges:=True

Application.DisplayAlerts = True
Application.ScreenUpdating = True
    Filename = Dir()
Loop
End Sub

以下是pivot的代码，单独运行时效果非常好：

Sub PivotX(WB As Workbook)
Dim Lrow, Lcol As Long
Dim wsData As Worksheet
Dim rngRaw As Range
Dim PvtTabCache As PivotCache
Dim PvtTab As PivotTable
Dim wsPvtTab As Worksheet
Dim PvtFld As PivotField

Set wsData = ActiveSheet
Lrow = wsData.Cells(Rows.Count, "B").End(xlUp).Row
Lcol = wsData.Cells(1, Columns.Count).End(xlToLeft).Column
Set rngRaw = wsData.Range(Cells(1, 1), Cells(Lrow, Lcol))
Set wsPvtTab = Worksheets.Add
wsData.Select
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rngRaw, Version:=xlPivotTableVersion12).CreatePivotTable TableDestination:=wsPvtTab.Range("A3"), TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion12

Set PvtTab = wsPvtTab.PivotTables("PivotTable1")

PvtTab.ManualUpdate = True
Set PvtFld = PvtTab.PivotFields("Month")
PvtFld.Orientation = xlPageField
PvtTab.PivotFields("Month").ClearAllFilters

Set PvtFld = PvtTab.PivotFields("Year")
PvtFld.Orientation = xlPageField
PvtTab.PivotFields("Year").ClearAllFilters

Set PvtFld = PvtTab.PivotFields("Fund_Code")
PvtFld.Orientation = xlRowField
PvtFld.Position = 1

Set PvtFld = PvtTab.PivotFields("Curr")
PvtFld.Orientation = xlColumnField
PvtFld.Position = 1
wsPvtTab.PivotTables("PivotTable1").PivotFields("Curr").PivotItems("USD").Position = 1

With PvtTab.PivotFields("Trx_Amount")
.Orientation = xlDataField
.Function = xlSum
.NumberFormat = "#,##0;[red](#,##0)"
End With

wsPvtTab.PivotTables("Pivottable1").RowAxisLayout xlTabularRow

'Remove grand total
wsPvtTab.PivotTables("Pivottable1").RowGrand = False

For Each PvtTbCache In ActiveWorkbook.PivotCaches
    On Error Resume Next
    PvtTbCache.Refresh
Next PvtTbCache

'Determine filter value
Set PvtFld = PvtTab.PivotFields("Year")
PvtFld.ClearAllFilters
PvtFld.EnableMultiplePageItems = True
  With PvtFld
    .AutoSort xlmnual, .SourceName
    For Each Pi In PvtFld.PivotItems
            Select Case Pi.Name
                Case "2014"
                Case Else
                    Pi.Visible = False
            End Select
    Next Pi
    .AutoSort xlAscending, .SourceName
  End With

'determine filter value
Set PvtFld = PvtTab.PivotFields("Month")
PvtFld.ClearAllFilters
PvtFld.EnableMultiplePageItems = True
  With PvtFld
    .AutoSort xlmnual, .SourceName
    For Each Pi In PvtFld.PivotItems
            Select Case Pi.Name
                Case "11"
                Case Else
                    Pi.Visible = False
            End Select
    Next Pi
    .AutoSort xlAscending, .SourceName
  End With
PvtTab.ManualUpdate = False
End Sub

非常感谢任何帮助。非常感谢你提前。

Answer 1

这可以解决您的问题：

Set WB = Workbooks.Open(Pathname & "\" & Filename)

当我尝试使用您的代码时，出于某种原因，它没有保留您在＆＃34;文件名＆＃34;开头的反斜杠。变量。这可以解释为什么VBA无法找到这些文件。在路径名和文件名之间添加它应该使其正常工作

Answer 2

我相信您已经找到了上述基本问题的答案，但我会提供以下“调整”以避免屏幕闪烁和未恢复的变量分配。

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Do While Filename <> ""
    Set WB = Workbooks.Open(Pathname & "\" & Filename)  'open all files
    Call PivotX(WB)
    WB.Close SaveChanges:=True
    Set WB = Nothing
    Filename = Dir()
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True

Set WB = Nothing在最后一次传递时实际上只是在没有重新分配WB但你的 PivotX 子在退出之前可以使用多个Set nnn = Nothing时才有用。虽然引用计数假设要递减（并且因此释放内存），但情况并非总是如此。（见Is there a need to set Objects to Nothing inside VBA Functions）简而言之，这只是一种很好的编码实践。

最后，使用Dim Filename, Pathname As String声明文件名作为变体，而不是字符串类型。这里没有任何区别，但你应该知道你的变量被声明为什么。

循环遍历同一文件夹中的工作簿，并为All-VBA执行相同的Excel任务

2 个答案: