获取多个excel中的固定单元格到新的单元格

问题描述 投票:-1回答:1

我是excel VBA中的新手,并且有一个关于从多个excel工作簿中获取数据到noew的问题。 我会在这里解释一下: 1.在主文件夹("C:\desktop\Main\")中,有多个子文件夹(这里我以folder A1folder A2为例)。 "C:\desktop\Main\A1\""C:\desktop\Main\A2\" 在每个子文件夹中,有多个excel。 例如:在folder A1,有2个文件夹(A1-2015.xlsxA1-2016.xlsx"C:\desktop\Main\A1\A1-2015.xlsx""C:\desktop\Main\A1\A1-2016.xlsx"folder A2,有3个文件夹(A2-2015.xlsxA2-2016.xlsxA2-2017.xlsx) 我希望将这些excel中的单元格转换为新的excel工作簿。 所以,根据对第1项的解释。我拿一个A1(A1-2016.xlsx)和一个A2(A2-2017.xlsx)excel为例。 A1 A1看起来像上面。 A2 A2在固定单元格中包含相同的模板,其中包含不同的数字/字符。 我想这样取他们: New Excel所有excel都有固定模板,如上例所示。 如果我有多个包含多个excel的文件夹,该怎么办?谢谢。

excel vba excel-vba
1个回答
2
投票

这取决于您是否知道主文件夹下有多少级别的子文件夹。如果这是可预测的,例如你知道只有以下两个级别(Main> A1)然后它非常简单。您想使用文件系统对象(将要求您从工具>引用菜单添加对Microsoft Scripting Runtime的引用)。

添加完之后,使用下面的代码为您完成工作(您可能需要稍微调整一下,因为我主要猜测要将哪些信息从文件合并到主文件中):

Sub Merge_Files()
    Dim FSO As New FileSystemObject
    Dim Main_Fold As Folder, Sub_1 As Folder
    Dim Fil As File
    Dim Main_WB As Workbook, New_WB As Workbook
    Dim X As Integer, Y As Integer
    Set Main_WB = ActiveWorkbook
    Set Main_Fold = FSO.GetFolder("C:\Desktop\Main\") 'Replace this with a reference to your actual main folder.
    For Each Sub_1 In Main_Fold.subFolders
        For Each Fil In Sub_1.Files
            Set New_WB = Workbooks.Open(Fil.Path)
            For X = 2 To 1000
                If Main_WB.Sheets(1).Range("A" & X).Value = "" Then
                        Main_WB.Sheets(1).Range("A" & X).Value = New_WB.Sheets(1).Range("C2").Value
                        Exit For
                End If
                If Main_WB.Sheets(1).Range("A" & X).Value = New_WB.Sheets(1).Range("C2").Value Then Exit For
            Next X
            For Y = 2 To 5
                Main_WB.Sheets(1).Cells(X, Y) = New_WB.Sheets(1).Range("C" & (Y + 1)).Value
            Next Y
            For Y = 4 To 9
                If Y = 6 Then Y = 7
                If Y < 6 Then
                        Main_WB.Sheets(1).Cells(X, Y + 2) = New_WB.Sheets(1).Cells(9, Y)
                    Else
                        Main_WB.Sheets(1).Cells(X, Y + 1) = New_WB.Sheets(1).Cells(9, Y)
                End If
            Next Y
            Main_WB.Sheets(1).Range("K" & X).Value = New_WB.Sheets(1).Range("K21").Value
            New_WB.Close SaveChanges:=False
        Next Fil
        Next Sub_1
End Sub
© www.soinside.com 2019 - 2024. All rights reserved.