如何用VBA匹配指定后缀Excel文件并合并生成新_0文件？

我有一批Excel文件，命名格式如Final_38200_1.xls、Final_38200_2.xls、Final_38200_3.xls等，还有带_0后缀的文件（如Final_38200_0.xls）。其中_0后缀的文件无需处理，需要将前缀匹配、后缀大于0的文件，在完成费率代码修改后，合并到一个新的Final_38200_0.xls文件中，所有数据放在同一张工作表里。

我已编写的费率修改VBA代码如下：

Sub Subshed_Rates()
    Dim ss As String
    Dim s As String
    Dim name As String
    Dim fso As New Scripting.FileSystemObject
    
    name = fso.GetBaseName(ActiveWorkbook.Name)
    s = Right(name, 1)
    
    If s > "0" Then
        ss = "S" & s
    ElseIf s = "0" Then
        Exit Sub
    End If
    
    Range("E1:E40000").Replace What:="*AG*", Replacement:=ss & " AG", _
        LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
        SearchFormat:=False, ReplaceFormat:=False
    Range("E1:E40000").Replace What:="*RES*", Replacement:=ss & " RES", _
        LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
        SearchFormat:=False, ReplaceFormat:=False
    Range("E1:E40000").Replace What:="*COM*", Replacement:=ss & " COMM", _
        LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
        SearchFormat:=False, ReplaceFormat:=False
End Sub

前置准备 #

• 将所有待处理的_1、_2等后缀文件，和要生成的_0文件放在同一个文件夹内。
• 打开Excel，按Alt+F11进入VBA编辑器，点击工具→引用，勾选Microsoft Scripting Runtime（与现有代码依赖一致）。

合并VBA代码 #

Sub Merge_Files_To_Zero()
    Dim fso As New Scripting.FileSystemObject
    Dim folderPath As String
    Dim baseName As String
    Dim targetFileName As String
    Dim sourceFile As File
    Dim wbSource As Workbook
    Dim wbTarget As Workbook
    Dim lastRowTarget As Long
    Dim lastRowSource As Long
    
    ' 获取当前文件夹路径
    folderPath = ThisWorkbook.Path
    If folderPath = "" Then folderPath = Application.DefaultFilePath
    
    ' 设置目标文件的前缀，根据实际情况修改
    baseName = "Final_38200"
    targetFileName = folderPath & "\" & baseName & "_0.xls"
    
    ' 打开或创建目标工作簿
    If fso.FileExists(targetFileName) Then
        Set wbTarget = Workbooks.Open(targetFileName)
    Else
        Set wbTarget = Workbooks.Add
        wbTarget.SaveAs targetFileName
    End If
    
    ' 遍历文件夹中符合条件的文件
    For Each sourceFile In fso.GetFolder(folderPath).Files
        ' 筛选xls格式文件
        If LCase(fso.GetExtensionName(sourceFile.Name)) = "xls" Then
            Dim fileNameWithoutExt As String
            fileNameWithoutExt = fso.GetBaseName(sourceFile.Name)
            
            ' 匹配前缀，且后缀为大于0的数字
            If Left(fileNameWithoutExt, Len(baseName)) = baseName Then
                Dim suffixStr As String
                suffixStr = Right(fileNameWithoutExt, Len(fileNameWithoutExt) - Len(baseName) - 1)
                
                If IsNumeric(suffixStr) And CInt(suffixStr) > 0 Then
                    ' 打开源文件
                    Set wbSource = Workbooks.Open(sourceFile.Path)
                    
                    ' 执行费率修改
                    Call Subshed_Rates
                    
                    ' 复制数据到目标工作簿（默认取第一个工作表）
                    With wbSource.Sheets(1)
                        lastRowSource = .Cells(.Rows.Count, "A").End(xlUp).Row
                        lastRowTarget = wbTarget.Sheets(1).Cells(wbTarget.Sheets(1).Rows.Count, "A").End(xlUp).Row
                        
                        ' 第一个文件复制表头，后续文件只复制数据行
                        If lastRowTarget = 1 Then
                            .Rows(1).Copy wbTarget.Sheets(1).Rows(1)
                            lastRowTarget = 2
                        End If
                        
                        .Range("A2:" & .Cells(lastRowSource, .Columns.Count).Address).Copy _
                            wbTarget.Sheets(1).Cells(lastRowTarget, 1)
                    End With
                    
                    ' 保存源文件修改并关闭
                    wbSource.Close SaveChanges:=True
                End If
            End If
        End If
    Next sourceFile
    
    ' 保存目标文件并激活
    wbTarget.Save
    wbTarget.Activate
    
    MsgBox "合并完成！目标文件路径：" & targetFileName
End Sub

使用步骤 #

1. 将上述代码粘贴到VBA编辑器的模块中。
2. 如果你的文件前缀不是Final_38200，修改代码里baseName = "Final_38200"这一行的内容。
3. 运行Merge_Files_To_Zero宏，程序会自动遍历符合条件的文件，执行费率修改，然后把所有数据合并到新的_0文件中。

内容的提问来源于stack exchange，提问作者Troy