Erhalten Sie feste Zellen in mehreren Excel zu dem neuen

Question

Ich bin sehr neu in Excel VBA und habe eine Frage zum Abrufen von Daten aus mehreren Excel-Arbeitsmappe zum Noew.
ich hier erklären:
1. In einem Hauptordner ("C:\desktop\Main\") gibt es mehrere Unterordner in es (hier nehme ich folder A1 und folder A2 als Beispiel). "C:\desktop\Main\A1\" & "C:\desktop\Main\A2\"
In jedem Unterordner sind mehrere Hervorhebungen enthalten.
Zum Beispiel: In folder A1 gibt es 2 Ordner (A1-2015.xlsx und A1-2016.xlsx) "C:\desktop\Main\A1\A1-2015.xlsx" und "C:\desktop\Main\A1\A1-2016.xlsx"
In folder A2 gibt es 3 Ordner (A2-2015.xlsx, A2-2016.xlsx und A2-2017.xlsx)
I-Zellen in diesen zeichnet sich in neue Excel-Arbeitsmappe erhalten möchten .
2. Also, basierend auf der Erklärung zu item1. Ich nehme einen von A1 (A1-2016.xlsx) und einen von A2 (A2-2017.xlsx) zum Beispiel.
A1 sieht wie oben aus.
A2 enthält die gleiche Vorlage in den festen Zellen mit unterschiedlichen Zahlen/Zeichen darin.
3. Ich möchte sie wie folgt abrufen:
Alle Excels haben feste Vorlage wie im obigen Beispiel.
Wie kann ich tun, wenn ich mehrere Ordner mit mehreren Excel in es habe? Danke.

Answer 1

Dies hängt davon ab, ob Sie wissen, wie viele Ebenen von Unterordnern Sie unter dem Hauptordner haben. Wenn dies vorhersehbar ist, z.B. Sie wissen, dass es nur die folgenden zwei Ebenen gibt (Main> A1), dann ist es ziemlich einfach. Sie möchten Dateisystemobjekte verwenden (Sie müssen einen Verweis auf Microsoft Scripting Runtime über das Menü Werkzeuge> Referenzen hinzufügen).

Sobald Sie das hinzugefügt haben, verwenden Sie den folgenden Code, um die Arbeit für Sie zu erledigen (Sie müssen möglicherweise etwas anpassen, da ich hauptsächlich rate, welche Informationen aus den Dateien in die Hauptdatei zusammengeführt werden sollen) :

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