Note: The other languages of the website are Google-translated. Back to English
English English

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

本文,我將討論如何在不打開文件的情況下同時跨多個工作簿文件運行宏。 以下方法可以幫助您解決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 執行此代碼的密鑰,以及一個 瀏覽 顯示窗口,請選擇一個文件夾,其中包含您要全部應用此宏的工作簿,請參見屏幕截圖:

doc運行宏多個文件2

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

 


最佳辦公效率工具

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

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

Office選項卡為Office帶來了選項卡式界面,使您的工作更加輕鬆

  • 在Word,Excel,PowerPoint中啟用選項卡式編輯和閱讀,發布者,Access,Visio和Project。
  • 在同一窗口的新選項卡中而不是在新窗口中打開並創建多個文檔。
  • 每天將您的工作效率提高50%,並減少數百次鼠標單擊!
officetab底部

 

按評論排序
留言 (39)
4.5中的5評分 · 1評級
網站主持人對此評論進行了最小化
非常有用的宏,它工作正常,但我希望能夠從該文件夾中選擇我希望運行宏的文件? 這些文件不會在單獨的文件夾中自動生成,我需要對該文件夾中的每組文件運行不同的宏,然後將它們移回初始文件夾中。
網站主持人對此評論進行了最小化
我按照說明進行操作,但出現編譯錯誤“Loop whtout Do”。 我錯過了什麼? 我的宏代碼非常簡單,只需更改指定行的字體大小。 它自己工作。 這是我所擁有的...請幫助

子循環文件()
將 xFd 調暗為 FileDialog
將 xFdItem 調暗為變體
將 xFileName 調暗為字符串
設置 xFd = Application.FileDialog(msoFileDialogFolderPicker)
如果 xFd.Show = -1 那麼
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
當 xFileName <> ""
與Workbooks.Open(xFdItem和xFileName)
'你的代碼在這裡
行(“2:8”)。選擇
使用 Selection.Font
.Name = "宋體"
大小= 12
.刪除線=假
.上標=假
.下標=假
.OutlineFont = 假
.Shadow = 假
.Underline = xlUnderlineStyleNone
.顏色 = -11518420
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
結束
xFileName = 目錄
循環
如果結束
END SUB
網站主持人對此評論進行了最小化
你好,亞托,
您錯過了代碼末尾的“End with”腳本,正確的應該是:
子循環文件()
將 xFd 調暗為 FileDialog
將 xFdItem 調暗為變體
將 xFileName 調暗為字符串
設置 xFd = Application.FileDialog(msoFileDialogFolderPicker)
如果 xFd.Show = -1 那麼
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
當 xFileName <> ""
與Workbooks.Open(xFdItem和xFileName)
'你的代碼在這裡
行(“2:8”)。選擇
使用 Selection.Font
.Name = "宋體"
大小= 16
.刪除線=假
.上標=假
.下標=假
.OutlineFont = 假
.Shadow = 假
.Underline = xlUnderlineStyleNone
.顏色 = -11518420
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
結束
結束
xFileName = 目錄
循環
如果結束
END SUB

請嘗試一下,希望對您有所幫助!
網站主持人對此評論進行了最小化
非常有用的宏,而且效果很好,但是我希望能夠從該文件夾中選擇要運行宏的文件? 例如,我在一個文件夾中有 4 個文件和其他 excel 文件,我只希望它在這 4 個特定文件上運行。 如何調整您的宏以讓我從該文件夾中選擇這 4 個文件?
網站主持人對此評論進行了最小化
嗨,喬爾,
要在特定工作簿中觸發相同的代碼,您應該應用以下代碼:

子循環文件()
將 xFd 調暗為 FileDialog
將 xFdItem 調暗為變體
將 xFileName 調暗為字符串
將 xFB 調暗為字符串
使用 Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True
.Filters.Clear
.Filters.添加“excel”、“*.xls*”
。展示
如果 .SelectedItems.Count < 1 則退出 Sub
對於 lngCount = 1 到 .SelectedItems.Count
xFileName = .SelectedItems(lngCount)
如果 xFileName <> "" 那麼
使用 Workbooks.Open(文件名:=xFileName)
'你的代碼
結束
如果結束
下一個 lngCount
結束
END SUB

請嘗試一下,希望對您有所幫助!
網站主持人對此評論進行了最小化
謝謝,真的很有幫助
網站主持人對此評論進行了最小化
您好!

我嘗試將我的代碼插入到您的代碼中,當我運行宏時,它給了我以下消息:運行時錯誤“429”:ActiveX 無法創建對象。 請告知如何修復它。 謝謝!

我的代碼:

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

將 A() 調暗為變體
ReDim A(1 到 RInput.Rows.Count, 0)
A = RInput.Value2

設置 d = CreateObject("Scripsting.Dictionary")

對於 i = 1 到 UBound(A)
如果 d.Exists(A(i, 1)) 那麼
d(A(i, 1)) = d(A(i, 1)) + 1
其他
d.添加 A(i, 1), 1
如果結束
下一頁
對於 i = 1 到 UBound(A)
A(i, 1) = d(A(i, 1))
下一頁

R輸出 = A
網站主持人對此評論進行了最小化
嗨,首先感謝您提供這個宏,這正是我想要的。 但是我確實有一個問題,有沒有辦法在每個窗口完成時關閉並保存它。 我有大量文件,並且在執行完成之前內存不足。
網站主持人對此評論進行了最小化
是的,如果您希望它以相同的名稱保存文件,只需在下面添加以下代碼:

'保存工作簿
ActiveWorkbook.Save
網站主持人對此評論進行了最小化
你好,凱特琳,
也許下面的代碼可以幫助您,每次運行您的特定代碼後,都會彈出一個保存文件提示框,提醒您保存工作簿。

子循環文件()
將 xFd 調暗為 FileDialog
將 xFdItem 調暗為變體
將 xFileName 調暗為字符串
將 xWB 調暗為工作簿
設置 xFd = Application.FileDialog(msoFileDialogFolderPicker)
如果 xFd.Show = -1 那麼
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
在錯誤恢復下一頁
當 xFileName <> ""
設置 xWB = Workbooks.Open(xFdItem & xFileName)
帶 xWB
'你的代碼在這裡
結束
xWB.關閉
xFileName = 目錄
循環
如果結束
END SUB
網站主持人對此評論進行了最小化
您好!

我嘗試將我的代碼插入到您的代碼中,當我運行宏時,它給了我以下消息:運行時錯誤“429”:ActiveX 無法創建對象。 請告知如何修復它。 謝謝!

我的代碼:

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

將 A() 調暗為變體
ReDim A(1 到 RInput.Rows.Count, 0)
A = RInput.Value2

設置 d = CreateObject("Scripsting.Dictionary")

對於 i = 1 到 UBound(A)
如果 d.Exists(A(i, 1)) 那麼
d(A(i, 1)) = d(A(i, 1)) + 1
其他
d.添加 A(i, 1), 1
如果結束
下一頁
對於 i = 1 到 UBound(A)
A(i, 1) = d(A(i, 1))
下一頁

R輸出 = A
網站主持人對此評論進行了最小化
你好,

我已經成功地使用這個宏為 30 支球隊格式化了 NBA 文件,每支球隊都有自己的書。 昨天,我收到一條錯誤消息,指出模塊(宏)無法完成或刪除或編輯(要保存)。 它損壞了我的個人宏工作簿,使 Excel 對我幾乎無法使用。 每次我嘗試從任何文件訪問宏時,它都會使應用程序崩潰。 Excel 支持和 Windows 支持無法解決問題。 你能幫我嗎?
網站主持人對此評論進行了最小化
嗨,有沒有辦法可以在腳本本身中定義文件目標。 我想跳過我們必須瀏覽特定文件夾的過程 3。
網站主持人對此評論進行了最小化
嗨,謝謝你的代碼。 你能告訴我如何獲得我在一張表中打開所有工作簿的宏的結果(連續每個工作簿的結果)? 有沒有辦法將每個工作簿的名稱添加到包含上一步數據的行中?
網站主持人對此評論進行了最小化
Hi

我收到 aa 1004 運行時錯誤:當我運行以下代碼時,語法不正確,該代碼是擴展 Office VBA 以“使用 VBA 代碼在多個工作簿中同時運行宏”和擴展 Office VBA“刪除所有命名範圍”使用 VBA 代碼”插入您的代碼槽:

子循環文件()

將 xFd 調暗為 FileDialog

將 xFdItem 調暗為變體

將 xFileName 調暗為字符串

設置 xFd = Application.FileDialog(msoFileDialogFolderPicker)

如果 xFd.Show = -1 那麼

xFdItem = xFd.SelectedItems(1) & Application.PathSeparator

xFileName = Dir(xFdItem & "*.xls*")

當 xFileName <> ""

與Workbooks.Open(xFdItem和xFileName)

' 子刪除名稱()

'更新 20140314

將 xName 調暗為名稱

對於 Application.ActiveWorkbook.Names 中的每個 xName

xName.刪除

下一頁


結束

xFileName = 目錄

循環

如果結束

END SUB

我想要做的是運行一個宏來刪除同一文件夾中包含的八個工作簿中的命名範圍。

順便說一句,這是我第一次使用 Extend Office 的東西,但它沒有用。 這個網站對我非常有幫助。

建議/意見將不勝感激。

阿爾茨海默氏症
網站主持人對此評論進行了最小化
你好,aldc,
您的代碼在我的工作簿中運行良好,您使用哪個 Excel 版本?
網站主持人對此評論進行了最小化
您好,這段代碼非常好用。 我經常使用它!

如今,在我的組織中,我們現在使用 SharePoint 來存儲我們的文件。 有什麼方法可以使此代碼在共享點文件夾中的所有文件中工作?
網站主持人對此評論進行了最小化
您好,感謝您提供此代碼。
有沒有辦法循環遍歷子文件夾? 假設我有一個文件夾,並且在該文件夾中還有十個文件夾,每個文件夾都包含一個 excel 文件。

有沒有辦法只選擇主文件夾,以便代碼在其所有子文件夾中運行?

謝謝。
網站主持人對此評論進行了最小化
嗨,Darko,要從包含子文件夾的文件夾中運行代碼,請應用以下代碼: 子 LoopThroughFiles_Subfolders(xStrPath 作為字符串)
暗淡 xSFolderName
暗淡 xFileName
將 xArrSFPath() 調暗為字符串
將 xI 調暗為整數
如果 xStrPath = "" 則退出 Sub
xFileName = Dir(xStrPath & "*.xls*")
當 xFileName <> ""
使用 Workbooks.Open(xStrPath & xFileName)
'你的代碼在這裡
結束
xFileName = 目錄
循環
xSFolderName = 目錄(xStrPath,vbDirectory)
xI = 0
重新調整 xArrSFPath(0)
Do While xSFolderName <> ""
如果 xSFolderName <> "." 和 xSFolderName <> ".." 然後
If (GetAttr(xStrPath & xSFolderName) And vbDirectory) = vbDirectory Then
xI = xI + 1
ReDim 保留 xArrSFPath(xI)
xArrSFPath(xI - 1) = xStrPath & xSFolderName & "\"
如果結束
如果結束
xSFolderName = 目錄
循環
如果 UBound(xArrSFPath) > 0 那麼
對於 xI = 0 到 UBound(xArrSFPath)
LoopThroughFiles_Subfolders (xArrSFPath(xI))
下一個
如果結束
END SUB
子循環文件()
將 xFd 調暗為 FileDialog
將 xFdItem 調暗為變體
將 xFileName 調暗為字符串
設置 xFd = Application.FileDialog(msoFileDialogFolderPicker)
如果 xFd.Show = -1 那麼
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
LoopThroughFiles_Subfolders (xFdItem)
如果結束
完子請試一試,希望能幫到你!
網站主持人對此評論進行了最小化
除了上面的代碼,是否可以按我想要的時間順序打開 excel 文件?
網站主持人對此評論進行了最小化
大家好,首先感謝宏,它使用起來非常方便。 我只是想知道我們是否有辦法通過宏刷新 onedrive 中的文件夾。 如果是的話,你能告訴我我可以在這裡做什麼來使用宏腳本刷新onedrive中的文件嗎?
網站主持人對此評論進行了最小化
嗨,非常感謝這個腳本,我工作得很好,但我有特殊需要:有沒有辦法更改腳本以將我的代碼與文件名條件和子文件夾一起應用?
我解釋說:我是一名教師,我創建了一個 Excel 解決方案來保存學生的成績並允許教師查閱他們。為此,我為每個學校的 subjet 和一個負責班級的文件都有一個文件,所有這些文件都在每個班級的一個文件夾中。
因此,當我發現錯誤或優化時,我必須報告所有子文件夾中所有文件的更改。
但是由於所有文件都不相同(不同的 subjets 組織),我想要一種方法將我的代碼示例應用於所有子文件夾中名為“數學類”的所有文件,或者相反,將我的代碼應用於所有文件在所有名為“xyz”的文件之外的子文件夾中。謝謝!Fabrice
網站主持人對此評論進行了最小化
您給定的代碼不適用於以下 VBA 可以請幫助Sub Bundles()

將 vWS 調暗為工作表
暗淡 vA, vA2()
將 vR 變暗、vSum 變暗、vC 變暗
將 vN 變暗、vN2 變暗、vN3 變暗

設置 vWS = ActiveSheet
使用 vWS
vR = .Cells(Rows.Count, 4).End(xlUp).Row
vSum = Application.Sum(.Range("D2:D" & vR))
ReDim 保留 vA2(1 到 vSum,1 到 4)
vA = .Range("A2:D" & vR)
對於 vN = 1 到 vR - 1
對於 vN2 = 1 至 vA(vN, 4)
vC = vC + 1
對於 vN3 = 1 至 4
vA2(vC, vN3) = vA(vN, vN3)
下一個 vN3
下一個 vN2
下一個 vN
結束
vC = 1
對於 vN = 1 到 vSum - 2
vA2(vN, 4) = vC
如果 vA2(vN + 1, 2) = vA2(vN, 2) 那麼
vC = vC + 1
vA2(vN + 1, 4) = vC
其他
vA2(vN + 1, 4) = 1
vC = 1
如果結束
下一個 vN
Application.ScreenUpdating = False
Sheets.add
使用ActiveSheet
vWS.Range("A1:D1").Copy .Range("A1:D1")
.Cells(2, 1).Resize(vSum, 4) = vA2
結束
Application.ScreenUpdating = True

END SUB
網站主持人對此評論進行了最小化
我想一次將這個 VBA 運行到一個文件夾中的多個工作表中,你可以幫助Sub Bundles()

將 vWS 調暗為工作表
暗淡 vA, vA2()
將 vR 變暗、vSum 變暗、vC 變暗
將 vN 變暗、vN2 變暗、vN3 變暗

設置 vWS = ActiveSheet
使用 vWS
vR = .Cells(Rows.Count, 4).End(xlUp).Row
vSum = Application.Sum(.Range("D2:D" & vR))
ReDim 保留 vA2(1 到 vSum,1 到 4)
vA = .Range("A2:D" & vR)
對於 vN = 1 到 vR - 1
對於 vN2 = 1 至 vA(vN, 4)
vC = vC + 1
對於 vN3 = 1 至 4
vA2(vC, vN3) = vA(vN, vN3)
下一個 vN3
下一個 vN2
下一個 vN
結束
vC = 1
對於 vN = 1 到 vSum - 2
vA2(vN, 4) = vC
如果 vA2(vN + 1, 2) = vA2(vN, 2) 那麼
vC = vC + 1
vA2(vN + 1, 4) = vC
其他
vA2(vN + 1, 4) = 1
vC = 1
如果結束
下一個 vN
Application.ScreenUpdating = False
Sheets.add
使用ActiveSheet
vWS.Range("A1:D1").Copy .Range("A1:D1")
.Cells(2, 1).Resize(vSum, 4) = vA2
結束
Application.ScreenUpdating = True

END SUB
網站主持人對此評論進行了最小化
我嘗試運行代碼,但錯誤“424:Object Required”出現在“With Workbooks.Open(xFdItem & xFileName)”行。 通過深入研究,似乎存儲在感興趣的文件夾中的 excels 工作簿不顯示/不存在(當窗口打開並顯示代碼時,如果我嘗試打開文件夾而不選擇它,它是空的)。 怎麼會這樣?
子循環文件()
將 xFd 調暗為 FileDialog
將 xFdItem 調暗為變體
將 xFileName 調暗為字符串
設置 xFd = Application.FileDialog(msoFileDialogFolderPicker)
如果 xFd.Show = -1 那麼
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
當 xFileName <> ""
與Workbooks.Open(xFdItem和xFileName)
Sheets.Add After:=ActiveSheet
表(“表 2”)。選擇
Sheets("Sheet2").Name = "Master"
表(“主”)。選擇
Sheets("Master").Move Before:=Sheets(1)
結束
xFileName = 目錄
循環
如果結束
END SUB


你能幫我解決這個問題嗎?
網站主持人對此評論進行了最小化
這是我最喜歡的網站,它有最清晰的說明(比任何 YouTube 視頻都多),我會一次又一次地回到它。 非常感謝你提供這些教程——你是一個悲傷的研究生的救命稻草。
網站主持人對此評論進行了最小化
子循環文件()
將 xFd 調暗為 FileDialog
將 xFdItem 調暗為變體
將 xFileName 調暗為字符串
設置 xFd = Application.FileDialog(msoFileDialogFolderPicker)
如果 xFd.Show = -1 那麼
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
當 xFileName <> ""
與Workbooks.Open(xFdItem和xFileName)
' ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
選擇.插入 Shift:=xlToRight
ActiveCell.Select
結束
xFileName = 目錄
循環
如果結束
結束子,請幫助。 順便說一句,我的 excel 文件擴展名是 (.csv - "comma delimited") 。 我在一個文件夾中有 500 個 excel 文件,每行平均大約有 500000 行。請幫助。 我只想在每個工作簿中插入列
網站主持人對此評論進行了最小化
你有沒有得到你的問題的答案? 我正在嘗試對 3700 多個 csv 文件做同樣的事情。 我只需要添加 1 列 (A)。
網站主持人對此評論進行了最小化
嗨,有需要的 Carly,為了解決您的問題,要運行多個 CSV 文件的代碼,您只需將 .xls 文件擴展名更改為 .csv,如下所示: 子循環文件()
將 xFd 調暗為 FileDialog
將 xFdItem 調暗為變體
將 xFileName 調暗為字符串
設置 xFd = Application.FileDialog(msoFileDialogFolderPicker)
如果 xFd.Show = -1 那麼
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.csv*")
當 xFileName <> ""
與Workbooks.Open(xFdItem和xFileName)
ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
選擇.插入 Shift:=xlToRight
ActiveCell.Select
結束
xFileName = 目錄
循環
如果結束
完子請試一試,希望能幫到你!
網站主持人對此評論進行了最小化
嗨,是否可以僅在具有特定名稱的不同工作簿的工作表中運行宏? 謝謝!!
網站主持人對此評論進行了最小化
嗨,薩拉,
抱歉,您提出的問題沒有好的解決方案。
感謝您!
這裡還沒有評論
載入更多
留下你的意見
以訪客身份發帖
×
評價此帖子:
0   字符
推薦地點