將多個.xls文件中的內容複製到最後一列中的一個文件和文件名中

Question

我有許多需要合併到一個大文件中的.xls，.csv和/或.xlsx文件。文件的結構總是相同的。例如，文件中「一」的樣子：

col A 
123 
456 
789 

但有八列和文件「兩節」，也有八列，看起來像：

col A 
1011 
1213 
1415 

就目前而言，我想複製所有表和文件名，也使得結果應該是這樣的：

col A filename 
123  one 
456  one 
789  one 
1011  two 
1213  two 
1415  two 

我想用VBA來解決這個問題。我發現this unfinished solution和其他一些VBA部件如this，但無法插入文件名。還有一個更多complicated/specific問題的解決方案，但我還沒有想出如何將代碼簡化爲我更簡單的問題。

Answer 1

你在這裏。

創建一個新的BLANK工作簿並將這些過程放置在一個標準的代碼模塊中。保存這個新文件，然後運行Fuji()。

Public Sub Fuji() 
    Dim c&, sPath$, sFile$, v, wsReport As Worksheet 
    On Error Resume Next 
    sPath = "c:\tmp\fiji\" '<-- Edit source file folder and INCLUDE final backslash. 
    ActiveSheet.Copy 
    Set wsReport = ActiveSheet 
    wsReport.Name = "Merged" 
    DoEvents 
    sFile = Dir(sPath & "*.*") 
    SetExcelEnvironment 1 
    Do 
     Application.StatusBar = "Processing... " & sPath & sFile 
     With Workbooks.Open(sPath & sFile) 
      With .Worksheets(1) 
       v = .Range(.[a1], .Cells(.Rows.Count, "a").End(xlUp)) 
       With wsReport.Cells(.Rows.Count, "a").End(xlUp)(2).Resize(UBound(v)) 
        .Value = v 
        .Offset(, 1) = sFile 
       End With 
      End With 
      .Close 0 
     End With 
     sFile = Dir 
    Loop Until sFile = "" 
    With wsReport 
     .Rows(1).Delete 
     .Cells.EntireColumn.AutoFit 
    End With 
    SetExcelEnvironment 0 
End Sub 

Private Sub SetExcelEnvironment(bProcessing As Boolean) 
    With Application 
     .DisplayAlerts = Not bProcessing 
     .ScreenUpdating = Not bProcessing 
     .StatusBar = "" 
     .DisplayStatusBar = bProcessing 
    End With 
End Sub 

注：此假定僅列A將被收集到報告文件和源文件的名稱將B列報

注：這是假定所有的文件位於同一個文件夾中，並且您可以在Fuji()例程頂部附近的sPath行上編輯該源文件夾的位置。

注意：這裏假設源文件夾只包含用這個過程將被剔除（並被Excel理解）的文件。

注意：這裏假定所有的源文件數據都來自第一張表。

UPDATE

基於多列數據的更新的要求，請使用此版本：

Public Sub Fuji() 
    Dim c&, sPath$, sFile$, v, wsReport As Worksheet 
    On Error Resume Next 
    sPath = "c:\tmp\fiji\" '<-- Edit this and INCLUDE final backslash. 
    sFile = Dir(sPath & "*.*") 
    ActiveSheet.Copy 
    Set wsReport = ActiveSheet 
    wsReport.Name = "Merged" 
    DoEvents 
    SetExcelEnvironment 1 
    Do 
     Application.StatusBar = "Processing... " & sPath & sFile 
     With Workbooks.Open(sPath & sFile) 
      With .Worksheets(1) 
       v = .[a1].CurrentRegion.Resize(.Cells(.Rows.Count, "a").End(xlUp).Row) 
       With wsReport.Cells(.Rows.Count, "a").End(xlUp)(2).Resize(UBound(v, 1), UBound(v, 2)) 
        .Value = v 
        .Offset(, UBound(v, 2)).Resize(, 1) = sFile 
       End With 
      End With 
      .Close 0 
     End With 
     sFile = Dir 
    Loop Until sFile = "" 
    With wsReport 
     .Rows(1).Delete 
     .Cells.EntireColumn.AutoFit 
    End With 
    SetExcelEnvironment 0 
End Sub 

Private Sub SetExcelEnvironment(bProcessing As Boolean) 
    With Application 
     .DisplayAlerts = Not bProcessing 
     .ScreenUpdating = Not bProcessing 
     .StatusBar = "" 
     .DisplayStatusBar = bProcessing 
    End With 
End Sub