使用VBA合并多个EXCEL文件到一个EXCEL文件

最新推荐文章于 2024-11-05 09:11:29 发布

王飞雁

最新推荐文章于 2024-11-05 09:11:29 发布

阅读量4.3k

点赞数 1

CC 4.0 BY-SA版权

文章标签：合并 vba 遍历

本文链接：https://blog.youkuaiyun.com/freelyeagle/article/details/50717312

本文介绍了一种使用VBA脚本批量合并多个Excel文件的方法。该脚本能够递归地搜索指定文件夹及其子文件夹中的所有Excel文件，并将这些文件的数据合并到一个新的Excel工作表中。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

有时候我们需要把一大堆的Excel文件合并一个文件，这时候我们可以想到利用VBA来做。

这涉及到遍历文件夹以及子文件夹，找出所有的文件，并且读取文件把它们的内容合并到同一个Excel文件中去。

下面的代码可以实现这样的操作。

Sub MergeData()

    Dim strFileName As String
    Dim strFolder As String
    Dim row As Integer
    Dim col As Integer
    Dim outRow As Integer
    Dim fob As Object
    Dim fFile As file
    Set fso = CreateObject("scripting.filesystemobject")
    '中间变量worksheet
    Dim wsTemp As Worksheet
    '中间变量workbook

    Dim wbTemp As Workbook
    Dim strMergedFilePath As String
    Dim wbMerged As Workbook
    '输出用worksheet变量

    Dim wsMerged As Worksheet
    '输出用地区名
    Dim strOutFolderName As String
    '输出用城市名
    Dim strOutFileName As String

    Application.Visible = False
    Application.ScreenUpdating = False

    strMergedFilePath = ThisWorkbook.Path & "\"

    Set wsMerged = ThisWorkbook.Sheets(2)

    wsMerged.Name = "test"

    strFolder = Cells(2, 3).Value

    If Dir(strFolder, 16) = Empty Then
        MsgBox "Folder not exits!", vbOKOnly
    End If

    Dim file() As String
    Dim f As String
    Dim i, k
    i = 2
    k = 1

ReDim file(1 To 1)

    '获取所有的子文件夹
    f = Dir(strFolder & "\", vbDirectory)
    Do Until f = ""
        If InStr(f, ".") = 0 Then
            k = k + 1
            ReDim Preserve file(1 To k)
            file(k) = f
        End If
        f = Dir
    Loop

    On Error Resume Next

    outRow = 3

    Do While i <= k

        strOutFolderName = file(i)

        strFileName = Dir(strFolder & "\" & file(i) & "\*.xlsx", vbDirectory)

        Do While strFileName <> ""

           strOutFileName = strFileName
           Set wbTemp = Workbooks.Open(strFolder & "\" & file(i) & "\" & strFileName)

           Set wsTemp = wbTemp.Sheets("test")


           If wsTemp Is Nothing Then
           Else

            If outRow = 3 Then
                row = 2
            Else
                row = 3
            End If


            Do While wsTemp.Cells(row, 1).Value <> ""

                If outRow = 3 Then
                    wsMerged.Cells(outRow, 1).Value = "地区"
                    wsMerged.Cells(outRow, 2).Value = "城市"
                Else
                    wsMerged.Cells(outRow, 1).Value = strOutFolderName
                    wsMerged.Cells(outRow, 2).Value = strOutFileName
                End If

                col = 1

                Do While wsTemp.Cells(row, col).Value <> ""


                    wsMerged.Cells(outRow, col + 2).Value = wsTemp.Cells(row, col).Value

                    col = col + 1

                Loop

                row = row + 1

                outRow = outRow + 1

            Loop

           End If

           wbTemp.Close
           strFileName = Dir

        Loop

        i = i + 1

    Loop

    wsMerged.Activate
    'wbMerged.SaveAs (strMergedFilePath & "MergedData.xlsx")
    Application.Visible = True

End Sub