Excel 在多个文件上运行宏_Excel_Vba

Excel 在多个文件上运行宏

excel vba

Excel 在多个文件上运行宏,excel,vba,Excel,Vba,每个月我都要清理700个新文件我有一个宏，但工作总是手动完成，一次一个文件我想一次在每个文件上运行这个宏 Sub IBO() Rows("1:6").Select Selection.Delete Shift:=xlUp Rows("16:18").Select Selection.Delete Shift:=xlUp ActiveWindow.SmallScroll Down:=6 Rows("31:38").Select Sele

每个月我都要清理700个新文件

我有一个宏，但工作总是手动完成，一次一个文件

我想一次在每个文件上运行这个宏

Sub IBO()

    Rows("1:6").Select
    Selection.Delete Shift:=xlUp
    Rows("16:18").Select
    Selection.Delete Shift:=xlUp
    ActiveWindow.SmallScroll Down:=6
    Rows("31:38").Select
    Selection.Delete Shift:=xlUp
    ActiveWindow.SmallScroll Down:=12
    Rows("46:46").Select
    Selection.Delete Shift:=xlUp
    Rows("46:47").Select
    Range("R46").Activate
    Selection.Delete Shift:=xlUp
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    ActiveWindow.SmallScroll Down:=15
    Rows("62:62").Select
    Selection.Delete Shift:=xlUp
    ActiveWindow.SmallScroll Down:=-24
    Rows("34:34").Select
    Selection.Insert Shift:=xlDown
    ActiveWindow.SmallScroll Down:=-9
    Rows("19:19").Select
    Selection.Insert Shift:=xlDown
    ActiveWindow.SmallScroll Down:=-12
    Rows("4:4").Select
    Selection.Insert Shift:=xlDown
    Range("B17:C17").Select
    ActiveWindow.SmallScroll Down:=6
    Range("B17:P32").Select
    Selection.Copy
    Range("R1").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=15
    Range("B33:T48").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("AG1").Select
    ActiveSheet.Paste
    Range("A1:A3").Select
    ActiveWindow.SmallScroll Down:=33
    Range("B49:M49").Select
    ActiveWindow.SmallScroll Down:=6
    Range("B49:S64").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("AZ1").Select
    ActiveSheet.Paste
    Range("BQ1").Select
End Sub

我只是想知道如何在某些东西上添加此宏，以便它可以同时在所有文件上运行。

基本上，您需要做两件事：

获取一个函数，该函数将循环遍历文件夹中的所有文件

更改IBO函数，使其引用不同工作簿中的单元格

函数Example1循环遍历目录中的所有文件，并尝试将每个文件作为excel工作簿打开，然后为每个工作簿调用函数IBO：

Sub Example1()

    dim FOLDERPATH as string
'change this to the path of your folder
    FOLDERPATH = "D:\"
  dim objwrkbook as workbook
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim i As Integer 

    ‘Create an instance of the FileSystemObject 
    Set objFSO = CreateObject(“Scripting.FileSystemObject”)
    ‘Get the folder object 
    Set objFolder = objFSO.GetFolder(FOLDERPATH)
    i = 1
    ‘loops through each file in the directory and prints their names and path 
    For Each objFile In objFolder.Files


        set objwrkbook = workbooks.add(objFile.Path)
       call IBO(objwrkbook)
        i = i + 1 
    Next objFile
End Sub

Sub IBO(byref objwrkbook as Workbook)

    objwrkbook.worksheets(1).Rows("1:6").Select
    Selection.Delete Shift:=xlUp
    objwrkbook.worksheets(1).Rows("16:18").Select
    Selection.Delete Shift:=xlUp
    ActiveWindow.SmallScroll Down:=6
    objwrkbook.worksheets(1).Rows("31:38").Select
    Selection.Delete Shift:=xlUp
    ActiveWindow.SmallScroll Down:=12
    objwrkbook.worksheets(1).Rows("46:46").Select
    Selection.Delete Shift:=xlUp
    objwrkbook.worksheets(1).Rows("46:47").Select
    objwrkbook.worksheets(1).Range("R46").Activate
    Selection.Delete Shift:=xlUp
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    ActiveWindow.SmallScroll Down:=15
    objwrkbook.worksheets(1).Rows("62:62").Select
    Selection.Delete Shift:=xlUp
    ActiveWindow.SmallScroll Down:=-24
    objwrkbook.worksheets(1).Rows("34:34").Select
    Selection.Insert Shift:=xlDown
    ActiveWindow.SmallScroll Down:=-9
    objwrkbook.worksheets(1).Rows("19:19").Select
    Selection.Insert Shift:=xlDown
    ActiveWindow.SmallScroll Down:=-12
    objwrkbook.worksheets(1).Rows("4:4").Select
    Selection.Insert Shift:=xlDown
    objwrkbook.worksheets(1).Range("B17:C17").Select
    ActiveWindow.SmallScroll Down:=6
    objwrkbook.worksheets(1).Range("B17:P32").Select
    Selection.Copy
    objwrkbook.worksheets(1).Range("R1").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=15
    objwrkbook.worksheets(1).Range("B33:T48").Select
    Application.CutCopyMode = False
    Selection.Copy
    objwrkbook.worksheets(1).Range("AG1").Select
    ActiveSheet.Paste
    objwrkbook.worksheets(1).Range("A1:A3").Select
    ActiveWindow.SmallScroll Down:=33
    objwrkbook.worksheets(1).Range("B49:M49").Select
    ActiveWindow.SmallScroll Down:=6
    objwrkbook.worksheets(1).Range("B49:S64").Select
    Application.CutCopyMode = False
    Selection.Copy
    objwrkbook.worksheets(1).Range("AZ1").Select
    ActiveSheet.Paste
    objwrkbook.worksheets(1).Range("BQ1").Select
End Sub

您需要对IBO函数进行一些更改，以便能够引用其他工作簿中的行和单元格。在下面的示例中，我假设您已将数据记录在工作簿的第1页上：

Sub Example1()

    dim FOLDERPATH as string
'change this to the path of your folder
    FOLDERPATH = "D:\"
  dim objwrkbook as workbook
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim i As Integer 

    ‘Create an instance of the FileSystemObject 
    Set objFSO = CreateObject(“Scripting.FileSystemObject”)
    ‘Get the folder object 
    Set objFolder = objFSO.GetFolder(FOLDERPATH)
    i = 1
    ‘loops through each file in the directory and prints their names and path 
    For Each objFile In objFolder.Files


        set objwrkbook = workbooks.add(objFile.Path)
       call IBO(objwrkbook)
        i = i + 1 
    Next objFile
End Sub

Sub IBO(byref objwrkbook as Workbook)

    objwrkbook.worksheets(1).Rows("1:6").Select
    Selection.Delete Shift:=xlUp
    objwrkbook.worksheets(1).Rows("16:18").Select
    Selection.Delete Shift:=xlUp
    ActiveWindow.SmallScroll Down:=6
    objwrkbook.worksheets(1).Rows("31:38").Select
    Selection.Delete Shift:=xlUp
    ActiveWindow.SmallScroll Down:=12
    objwrkbook.worksheets(1).Rows("46:46").Select
    Selection.Delete Shift:=xlUp
    objwrkbook.worksheets(1).Rows("46:47").Select
    objwrkbook.worksheets(1).Range("R46").Activate
    Selection.Delete Shift:=xlUp
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    ActiveWindow.SmallScroll Down:=15
    objwrkbook.worksheets(1).Rows("62:62").Select
    Selection.Delete Shift:=xlUp
    ActiveWindow.SmallScroll Down:=-24
    objwrkbook.worksheets(1).Rows("34:34").Select
    Selection.Insert Shift:=xlDown
    ActiveWindow.SmallScroll Down:=-9
    objwrkbook.worksheets(1).Rows("19:19").Select
    Selection.Insert Shift:=xlDown
    ActiveWindow.SmallScroll Down:=-12
    objwrkbook.worksheets(1).Rows("4:4").Select
    Selection.Insert Shift:=xlDown
    objwrkbook.worksheets(1).Range("B17:C17").Select
    ActiveWindow.SmallScroll Down:=6
    objwrkbook.worksheets(1).Range("B17:P32").Select
    Selection.Copy
    objwrkbook.worksheets(1).Range("R1").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=15
    objwrkbook.worksheets(1).Range("B33:T48").Select
    Application.CutCopyMode = False
    Selection.Copy
    objwrkbook.worksheets(1).Range("AG1").Select
    ActiveSheet.Paste
    objwrkbook.worksheets(1).Range("A1:A3").Select
    ActiveWindow.SmallScroll Down:=33
    objwrkbook.worksheets(1).Range("B49:M49").Select
    ActiveWindow.SmallScroll Down:=6
    objwrkbook.worksheets(1).Range("B49:S64").Select
    Application.CutCopyMode = False
    Selection.Copy
    objwrkbook.worksheets(1).Range("AZ1").Select
    ActiveSheet.Paste
    objwrkbook.worksheets(1).Range("BQ1").Select
End Sub

您也可以在我的博客中看到这篇关于循环浏览文件夹中文件的文章

我很欣赏Ammara Digital Solutions提供的功能。它与文件夹选择器很好地匹配

Public Function RecursiveDir(colFiles As Collection, _
                             strFolder As String, _
                             strFileSpec As String, _
                             bIncludeSubfolders As Boolean)

    Dim strTemp As String
    Dim colFolders As New Collection
    Dim vFolderName As Variant

    'Add files in strFolder matching strFileSpec to colFiles
    strFolder = TrailingSlash(strFolder)
    strTemp = Dir(strFolder & strFileSpec)
    Do While strTemp <> vbNullString
        colFiles.Add strFolder & strTemp
        strTemp = Dir
    Loop

    If bIncludeSubfolders Then
        'Fill colFolders with list of subdirectories of strFolder
        strTemp = Dir(strFolder, vbDirectory)
        Do While strTemp <> vbNullString
            If (strTemp <> ".") And (strTemp <> "..") Then
                If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0 Then
                    colFolders.Add strTemp
                End If
            End If
            strTemp = Dir
        Loop

        'Call RecursiveDir for each subfolder in colFolders
        For Each vFolderName In colFolders
            Call RecursiveDir(colFiles, strFolder & vFolderName, strFileSpec, True)
        Next vFolderName
    End If

End Function

Public Function TrailingSlash(strFolder As String) As String
    If Len(strFolder) > 0 Then
        If Right(strFolder, 1) = "\" Then
            TrailingSlash = strFolder
        Else
            TrailingSlash = strFolder & "\"
        End If
    End If
End Function

Sub myMacro()

    Dim strPath As String
    Dim colFiles As New Collection
    Dim varFile As Variant
    Dim wbkMyBook As Workbook

'* This is a folder picker. Left click a folder once
'* and choose select to set strPath equal to that folder.

    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select a folder"      '* Set the title of the folder picker window.
        .AllowMultiSelect = False       '* Do not allow multiple folders to be selected.
        .InitialFileName = "documents"  '* Set the initial location to the Windows "My Documents" folder.
        If .Show = True Then
            strPath = .SelectedItems(1) '* Set strPath equal to the selected folder.
        Else
            Exit Sub                    '* Exit the sub if you click cancel on the folder picker window.
        End If
    End With

'* Here RecursiveDir is called. It creates a collection
'* of all files (colFiles) in the path (strPath) that
'* match the filter ("*.xlsx"). The last argument (True)
'* instructs RecursiveDir to search subfolders.

    RecursiveDir colFiles, strPath, "*.xlsx", True

    For Each varFile In colFiles
        Set wbkMyBook = Workbooks.Open(varFile)

'* This is where you perform your work on each file.
'* The variable (varFile) references the current file
'* over which RecursiveDir is looping.

        Debug.Print varFile
        wbkMyBook.Sheets(1).Cells(1, 1) = "Hello."
        wbkMyBook.Close SaveChanges:=True

    Next varFile

End Sub

公共函数RecursiveDir（colFiles作为集合_
strFolder作为字符串_
strFileSpec作为字符串_
bIncludeSubfolders（作为布尔值）
将strTemp设置为字符串
将文件夹设置为新集合
Dim vFolderName作为变体
'将strFolder中与strFileSpec匹配的文件添加到colFiles
strFolder=TrailingSlash（strFolder）
strTemp=Dir（strFolder和strFileSpec）
当strTemp vbNullString时执行
添加strFolder和strTemp
strTemp=Dir
环
如果bIncludeSubfolders，则
'用strFolder的子目录列表填充colFolders
strTemp=Dir（strFolder，vbDirectory）
当strTemp vbNullString时执行
如果（strTemp“.”）和（strTemp“.”），则
如果（GetAttr（strFolder&strTemp）和vbDirectory）0，则
colFolders.addstrtemp
如果结束
如果结束
strTemp=Dir
环
'为colFolders中的每个子文件夹调用RecursiveDir
对于colFolders中的每个vFolderName
调用RecursiveDir（colFiles、strFolder和vFolderName、strFileSpec、True）
下一个vFolderName
如果结束
端函数
公共函数TrailingSlash（strFolder作为字符串）作为字符串
如果Len（strFolder）>0，则
如果正确（strFolder，1）=“\”则
TrailingSlash=strFolder
其他的
TrailingSlash=strFolder&“\”
如果结束
如果结束
端函数
子myMacro（）
将strPath设置为字符串
将文件作为新集合
Dim varFile作为变量
将wbkMyBook设置为工作簿
“*这是一个文件夹选择器。左键单击文件夹一次
'*并选择select以将strPath设置为该文件夹。
使用Application.FileDialog（msoFileDialogFolderPicker）
.Title=“选择文件夹”*设置文件夹选择器窗口的标题。
.AllowMultiSelect=False'*不允许选择多个文件夹。
.InitialFileName=“documents”*将初始位置设置为Windows“我的文档”文件夹。
如果.Show=True，则
strPath=.SelectedItems（1）“*将strPath设置为与所选文件夹相等。
其他的
退出子文件夹“*如果在文件夹选择器窗口中单击“取消”，则退出子文件夹。
如果结束
以
“*这里称为RecursiveDir。它创建一个集合
'*路径（strPath）中的所有文件（colFiles）的
'*匹配过滤器（“*.xlsx”）。最后一个参数（True）
'*指示RecursiveDir搜索子文件夹。
RecursiveDir colFiles，strPath，“*.xlsx”，True
对于colFiles中的每个varFile
设置wbkMyBook=Workbooks.Open（varFile）
“*这是您对每个文件执行工作的地方。
'*变量（varFile）引用当前文件
'*RecursiveDir在其上循环。
调试文件
wbkMyBook.Sheets（1）.Cells（1,1）=“您好。”
wbkMyBook.Close SaveChanges:=True
下一个变量文件
端接头

查看循环的

结构和Dir（）
方法。这是你需要完成的两件事。@BernardSaucier的+1。宏的作用是次要的。首先，您必须知道如何将任何宏应用于多个文件。尽管使用Dir
在文件中循环最好使用Do循环
来实现。使用FileSystemObject
@Kapol同意，我的坏，AFor
循环在这里效果最好！远离Do循环
更安全，因为它可以（如果语法混乱）在不满足条件的情况下执行一次。@BernardSaucier确切地说，这是我这边的疏忽。@Kapol我们是一个地狱般的团队：对于初学者来说，pNot不是一个非常全面的解决方案。。。BernardSaucier在三个月前开始学习VBA时，我特别欣赏StackOverflow的答案，这些答案不太具体，因为我不必为了将解决方案应用到我的问题而清楚地理解第一人称的问题。这是个人喜好。此外，另一个答案已经提供了具体的指导，所以我决定从一个不知名的来源分享我认为是有价值的公共功能。这是正确的观点。每当你对帖子进行编辑时，将删除我的否决票（在那之前不要让我）。@BernardSaucier我添加了一些注释和将每个文件更改为RecursiveDir循环的示例。@Bernad，谢谢你，有很多信息，我会看一看并尝试完成。谢谢你，每个工作表只有一张以工作表命名的工作表。另外，你的博客看起来不错，Thank.np，很高兴我能帮上忙：）我在运行'438'时遇到了一个“错误对象无法接受此方法”从葡萄牙语到英语应用程序的粗略翻译