Question

我有很多.xls，.csv和/或.xlsx文件，我需要将它们合并到一个大文件中。文件的结构始终相同。例如，文件“one”看起来像：

col A
123
456
789

但有八列和文件“两个”，也有八列，看起来像：

目前，我想要复制所有工作表和文件名，以便结果如下：

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理解）的文件。

注意：这假定所有源文件数据都来自第一张表。

<强>更新

根据您对多列数据的更新要求，请使用此版本：

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

将多个.xls文件中的内容复制到最后一列中的一个文件和文件名中

1 个答案: