提示:其他語言是Google翻譯的。 你可以訪問 English 版本。
登入
x
or
x
x
註冊
x

or

如何跨多個工作簿文件同時運行宏?

在本文中,我將討論如何在不打開多個工作簿文件的情況下跨多個工作簿文件運行宏。 以下方法可以幫助您在Excel中解決此任務。

使用VBA代碼在多個工作簿中運行宏


使用VBA代碼在多個工作簿中運行宏

若要在不打開多個工作簿的情況下運行宏,請應用以下VBA代碼:

1。 按住 ALT + F11 鍵打開 Microsoft Visual Basic for Applications 窗口。

2。 點擊 插入 > 模塊,並將下面的宏粘貼到 模塊 窗口。

VBA代碼:同時在多個工作簿上運行相同的宏:

Sub LoopThroughFiles()
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.xls*")
        Do While xFileName <> ""
            With Workbooks.Open(xFdItem & xFileName)
                'your code here
            End With
            xFileName = Dir
        Loop
    End If
End Sub

備註:在上面的代碼中,請複制並粘貼您自己的代碼,而不是 標題和 END SUB 之間的頁腳 使用Workbooks.Open(xFdItem和xFileName) - 結束 腳本。 查看截圖:

doc運行宏多個文件1

3。 然後按 F5 執行此代碼的關鍵,和a 瀏覽 窗口顯示,請選擇一個文件夾,其中包含您要應用此宏的工作簿,請參見屏幕截圖:

doc運行宏多個文件2

4. 然後點擊 OK 按鈕,所需的宏將立即從一個工作簿執行到其他工作簿。


Kutools for Excel解決了您的大多數問題,並使您的生產率提高了80%

  • 重用: 快速插入 複雜的公式,圖表 以及你以前用過的任何東西; 加密單元格 密碼; 創建郵件列表 並發送電子郵件...
  • 超級方程式酒吧 (輕鬆編輯多行文字和公式); 閱讀佈局 (輕鬆讀取和編輯大量單元格); 粘貼到過濾範圍...
  • 合併單元格/行/列 不丟失數據; 分裂細胞含量; 組合重複的行/列...防止重複的細胞; 比較範圍...
  • 選擇複製或唯一 行; 選擇空行 (所有細胞都是空的); 超級查找和模糊查找 在許多工作簿中; 隨機選擇......
  • 精確複製 多個單元格而不更改公式參考; 自動創建參考 多張表; 插入項目符號,複選框等等......
  • 提取文本,添加文本,按位置刪除, 刪除空間; 創建和打印分頁小計; 在單元格內容和註釋之間轉換...
  • 超級過濾器 (將過濾方案保存並應用到其他工作表); 高級排序 按月/週/日,頻率等; 特殊過濾器 用粗體,斜體......
  • 結合工作簿和工作表; 根據鍵列合併表; 將數據拆分為多個表格; 批量轉換xls,xlsx和PDF...
  • 超過300強大的功能。 支持Office / Excel 2007-2019和365。 支持所有語言。 在您的企業或組織中輕鬆部署。 全功能30天免費試用。
kte tab 201905

Office選項卡為Office提供選項卡式界面,使您的工作更輕鬆

  • 在Word,Excel,PowerPoint中啟用選項卡式編輯和閱讀,Publisher,Access,Visio和Project。
  • 在同一窗口的新選項卡中打開並創建多個文檔,而不是在新窗口中。
  • 通過50%提高您的工作效率,每天為您減少數百次鼠標點擊!
官方底部
Say something here...
symbols left.
You are guest ( Sign Up? )
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    Ltrung · 1 months ago
    Hi!

    I try to insert my code into yours and when I run the macro it gives me the following message: Run-time error '429': ActiveX can't create the object. Please advised on how it can be fixed. Thank you!

    My code:

    Set RInput = Range("A2:A21")
    Set ROutput = Range("D2:D22")

    Dim A() As Variant
    ReDim A(1 To RInput.Rows.Count, 0)
    A = RInput.Value2

    Set d = CreateObject("Scripsting.Dictionary")

    For i = 1 To UBound(A)
    If d.Exists(A(i, 1)) Then
    d(A(i, 1)) = d(A(i, 1)) + 1
    Else
    d.Add A(i, 1), 1
    End If
    Next
    For i = 1 To UBound(A)
    A(i, 1) = d(A(i, 1))
    Next

    ROutput = A
  • To post as a guest, your comment is unpublished.
    Caitlin Jarvis · 4 months ago
    Hi, firstly thank you for this macro, it was exactly what I was looking for. I do however have one problem, is there a way to close and save as each window as it completes. I have a large amount of files and I'm running out of RAM before the execution is complete.
    • To post as a guest, your comment is unpublished.
      skyyang · 4 months ago
      Hello, Caitlin ,
      Maybe the below code can help you, each time after running your specific code, a save file prompt box will pop out remind you to save the workbook.

      Sub LoopThroughFiles()
      Dim xFd As FileDialog
      Dim xFdItem As Variant
      Dim xFileName As String
      Dim xWB As Workbook
      Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
      If xFd.Show = -1 Then
      xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
      xFileName = Dir(xFdItem & "*.xls*")
      On Error Resume Next
      Do While xFileName <> ""
      Set xWB = Workbooks.Open(xFdItem & xFileName)
      With xWB
      'your code here
      End With
      xWB.Close
      xFileName = Dir
      Loop
      End If
      End Sub
    • To post as a guest, your comment is unpublished.
      Manvir Rai · 4 months ago
      Yes, Just add the below your following code if you wish it to save the file with the same name:

      'Saving the Workbook
      ActiveWorkbook.Save
  • To post as a guest, your comment is unpublished.
    Joel · 8 months ago
    Very useful macro, and it works great, but I would like to be able to select which files from that folder I want the macro to be ran on? For example I have 4 files in a folder with other excel files and I only want it ran on those 4 specific files. How can I tweak your macro to let me pick those 4 files from that folder?
    • To post as a guest, your comment is unpublished.
      skyyang · 8 months ago
      Hi, Joel,
      To trigger the same code in specific workbooks, you should apply the below code:

      Sub LoopThroughFiles()
      Dim xFd As FileDialog
      Dim xFdItem As Variant
      Dim xFileName As String
      Dim xFB As String
      With Application.FileDialog(msoFileDialogOpen)
      .AllowMultiSelect = True
      .Filters.Clear
      .Filters.Add "excel", "*.xls*"
      .Show
      If .SelectedItems.Count < 1 Then Exit Sub
      For lngCount = 1 To .SelectedItems.Count
      xFileName = .SelectedItems(lngCount)
      If xFileName <> "" Then
      With Workbooks.Open(Filename:=xFileName)
      'your code
      End With
      End If
      Next lngCount
      End With
      End Sub

      Please try it, hope it can help you!
      • To post as a guest, your comment is unpublished.
        Ltrung · 1 months ago
        Hi!

        I try to insert my code into yours and when I run the macro it gives me the following message: Run-time error '429': ActiveX can't create the object. Please advised on how it can be fixed. Thank you!

        My code:

        Set RInput = Range("A2:A21")
        Set ROutput = Range("D2:D22")

        Dim A() As Variant
        ReDim A(1 To RInput.Rows.Count, 0)
        A = RInput.Value2

        Set d = CreateObject("Scripsting.Dictionary")

        For i = 1 To UBound(A)
        If d.Exists(A(i, 1)) Then
        d(A(i, 1)) = d(A(i, 1)) + 1
        Else
        d.Add A(i, 1), 1
        End If
        Next
        For i = 1 To UBound(A)
        A(i, 1) = d(A(i, 1))
        Next

        ROutput = A
      • To post as a guest, your comment is unpublished.
        Belema · 5 months ago
        thanks, was really helpful
  • To post as a guest, your comment is unpublished.
    yarto logistics · 8 months ago
    I followed instructions but get a compile error "Loop wihtout Do". What am i missing? My macro code is very simple just change font size of specified rows. Works by it self. Here is what I have... please help

    Sub LoopThroughFiles()
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
    xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
    xFileName = Dir(xFdItem & "*.xls*")
    Do While xFileName <> ""
    With Workbooks.Open(xFdItem & xFileName)
    'your code here
    Rows("2:8").Select
    With Selection.Font
    .Name = "Arial"
    .Size = 12
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .Color = -11518420
    .TintAndShade = 0
    .ThemeFont = xlThemeFontNone
    End With
    xFileName = Dir
    Loop
    End If
    End Sub
    • To post as a guest, your comment is unpublished.
      skyyang · 8 months ago
      Hello, yarto,
      You missed the "End with" script at the end of your code, the correct one should be this:
      Sub LoopThroughFiles()
      Dim xFd As FileDialog
      Dim xFdItem As Variant
      Dim xFileName As String
      Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
      If xFd.Show = -1 Then
      xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
      xFileName = Dir(xFdItem & "*.xls*")
      Do While xFileName <> ""
      With Workbooks.Open(xFdItem & xFileName)
      'your code here
      Rows("2:8").Select
      With Selection.Font
      .Name = "Arial"
      .Size = 16
      .Strikethrough = False
      .Superscript = False
      .Subscript = False
      .OutlineFont = False
      .Shadow = False
      .Underline = xlUnderlineStyleNone
      .Color = -11518420
      .TintAndShade = 0
      .ThemeFont = xlThemeFontNone
      End With
      End With
      xFileName = Dir
      Loop
      End If
      End Sub

      Please try it, hope it can help you!
  • To post as a guest, your comment is unpublished.
    Iulia Curtman · 1 years ago
    Very useful macro, and it works fine, but I would like to be able to select which files from that folder I want the macro to be ran on? The files are not generated automatically in a separate folder, and I need to run different macros on each set of files from that folder, and then move them back in the initial folder.