Question

我正在搜索代码，以便在同一文件夹目录中的200多个文件上运行相同的宏，直到最后一个文件完成。

我点击一个按钮

后，我目前正在执行此操作

刷新.CSV数据连接（弹出文件选择窗口）目录，我选择文件）
刷新数据透视表
删除特定标签
将副本另存为另一个目录

我想省去200多次单击RUN按钮，然后选择.CSV文件。有人会碰巧知道可以做到这一点的代码吗？

目前的MACRO是：

Sub Load_Brand3()

 ' Load_Brand3 Macro

Sheets("Data").Select
Range("DATATable[[#Headers],[Datetime]]").Select
Selection.ListObject.TableObject.Refresh
Sheets("Brand Summary").Select
Range("A13").Select
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
ActiveSheet.PivotTables("PivotTable1").PivotFields("Retailer.Name").ShowDetail _
    = False
Sheets("Brand Summary").Select 

Dim SavedCopy As Excel.Workbook

ActiveWorkbook.SaveCopyAs "C:\Users\ME" & Format(Date, "mmddyyyy") & "-" & [A1] & ".xlsm"
Workbooks.Open "C:\Users\ME" & Format(Date, "mmddyyyy") & "-" & [A1] & ".xlsm"

Set SavedCopy = ActiveWorkbook

With SavedCopy
ActiveWorkbook.Connections("BrandExport").Delete
Application.DisplayAlerts = False
.Worksheets("Lookup").Delete
.Worksheets("Count").Delete
Sheets("Brand Summary").Select
Range("A1").Select
Application.DisplayAlerts = True
.Close True

End With

MsgBox ("Your File was saved.")

End Sub

Answer 1

这应该很接近。只需将MyPath更改为正确的目录，然后运行ProcessFiles。

Sub ProcessFiles()
    Const MyPath As String = "C:\Users\best buy\Data Files\*.csv"
    Dim FileName As String

    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
    End With

    FileName = Dir(MyPath, vbDirectory)
    Do While FileName <> ""
        Load_BrandFile FileName
        FileName = Dir()
    Loop

    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = True
    End With

End Sub

Sub Load_BrandFile(FileName As String)
    Dim SavedCopy As Workbook
    Dim DATATable As ListObject
    Dim PivotTable1 As PivotTable

    ThisWorkbook.SaveCopyAs "C:\Users\ME" & Format(Date, "mmddyyyy") & "-" & [A1] & ".xlsm"
    Set SavedCopy = Workbooks.Open("C:\Users\ME" & Format(Date, "mmddyyyy") & "-" & [A1] & ".xlsm")

    With SavedCopy
        Set DATATable = .Worksheets("Data").ListObjects("DATATable")
        DATATable.Refresh

        Set PivotTable1 = .Worksheets("Brand Summary").PivotTables("PivotTable1")
        PivotTable1.PivotCache.Connection = FileName
        PivotTable1.PivotFields("Retailer.Name").ShowDetail = False

        .Connections("BrandExport").Delete
        .Worksheets("Lookup").Delete
        .Worksheets("Count").Delete
        Application.Goto Reference:=.Worksheets("Brand Summary").Range("A1"), scroll:=True
        .Close True
    End With
End Sub

Answer 2

希望这能为你排序。

Sub CycleFolder()

Dim folderSelect As FileDialog

Set folderSelect = Application.FileDialog(msoFileDialogFolderPicker)
With folderSelect
    .AllowMultiSelect = False
    If .Show <> -1 Then Exit Sub
    strItem = .SelectedItems(1)
End With

Files = Dir(strItem & "\")

While Files <> ""
  'RUN FUNCTION HERE
  'Uncomment next line to test iteration
  'Debug.Print Files
  Files = Dir
Wend

End Sub

Excel VBA或脚本运行相同的宏（从1个文件刷新数据连接，并在同一目录中的其他文件上重复）

2 个答案: