将多个 csv 文件中的数据导入一个 Excel 工作表并计算平均值

Question

我正在尝试在 Excel 2010 中创建一个宏，它将存储在子文件夹中的未知数量的以分号分隔的 csv 文件中的单列数值数据导入到主工作簿中的连续列中。宏应从打开的主工作簿运行。

起始单元格是已知的，但列范围的大小可以变化。

每个文件名都不同。

如果文件名是“文件名 - 60.00mm.csv”，

我希望使用“60.00”作为列标题并将其格式化为数字。这需要取自 csv 工作簿的名称，因为它不是工作表名称的一部分。我已经做到了。

主工作簿的 A 列标题为“扫描编号”，行填充有数字 1、2、3 等，但最大数据范围需要多少行。我还没有弄清楚如何做到这一点。

在最大数据范围的最后一个填充行下方的一行，我希望计算上面所有数据的平均值，不包括标题行。 A 列中这一行的标题应为“平均”。我已经研究了如何计算平均值，但不知道如何将其输出到最大数据范围的最后一个填充行下方的行。它当前位于数据集正下方的单元格中。

我已经设法创建了一个宏，它将查找并循环遍历所有 csv 文件，并选择和复制相关数据范围，但是我在不使用“激活”和“选择”的情况下将其粘贴到主工作簿中时遇到了问题”。它还会跳过 A 列并粘贴到 B 列。

另外，如果不按顺序打开和关闭每个 csv 文件，我就无法使用它。

任何人都可以协助改进此代码以及提供缺失部分的最有效方法吗？

当前代码： 选项显式 子导入()

Dim New_Path As String 
Dim CSV_WB As Workbook
Dim Data As Variant 
Dim CSV_files As String 
Dim lastrow_CSV As Long 
Dim lastrow As Long 
Dim lastcol As Long 
Dim CSV_Sht_Name As String 
Dim CSV_Wbk_Title As String 
Dim averageRange As Variant 

New_Path = ThisWorkbook.Path & "Sub folder"
CSV_files = Dir(New_Path & "*.csv")

Do While Len(CSV_files) > 0

    Workbooks.OpenText _
    Filename:=New_Path & CSV_files, _
    DataType:=xlDelimited, _
    Semicolon:=True, _
    Local:=True

'Copy data.
    Set CSV_WB = Workbooks(CSV_files)
    CSV_Sht_Name = ActiveSheet.Name
    CSV_Wbk_Title = Val(Left(Right(ActiveWorkbook.Name, 11), 5))
    lastrow_CSV = CSV_WB.Worksheets(CSV_Sht_Name).Range("C" & Rows.Count).End(xlUp).Row

    Data = CSV_WB.Worksheets(CSV_Sht_Name).Range("C14:C" & lastrow_CSV).Copy

'Paste Data
    Windows("Master Workbook").Activate

    lastcol = Cells(2, Columns.Count).End(xlToLeft).Column

    Cells(1, lastcol).Offset(, 1).Value = CSV_Wbk_Title

    Cells(1, lastcol).Offset(1, 1).Select
    ActiveSheet.Paste

'Add average.
    lastrow = Cells(Rows.Count, lastcol + 1).End(xlUp).Row

    averageRange = Range(Cells(2, lastcol + 1), Cells(lastrow, lastcol + 1))

    With Cells(lastrow + 1, lastcol + 1)
        .Value = Application.WorksheetFunction.Average(averageRange)
        .Font.Bold = True
    End With

    CSV_WB.Close

    CSV_files = Dir

Loop

End Sub

Answer 1

这里是一些你可以修改的代码，可以直接将数据读入master，而无需打开每个文件。

'Created by Fredrik Östman www.scoc.se
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim file_text_tmp As String
Dim i As Integer

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("E:\")

field_num = 3
delimiter = ";"

col = 1
For Each objFile In objFolder.Files
    Cells(1, col) = Val(Left(Right(objFile.Name, 11), 5))
    Open objFile.Path For Input As #1
        Row = 2
        Do While Not EOF(1)
            Line Input #1, file_text_tmp
            If field_num > 1 Then
                For k = 1 To field_num - 1
                    file_text_tmp = Right(file_text_tmp, Len(file_text_tmp) - InStr(1, file_text_tmp, delimiter))
                Next k
            End If
            if InStr(1, file_text_tmp, delimiter) = 0 then
                Cells(Row, col)=file_text_tmp
            else
                Cells(Row, col) = Left(file_text_tmp, InStr(1, file_text_tmp, delimiter) - 1)
            end if
            Row = Row + 1
        Loop
    Close #1
    col = col + 1
Next objFile

Rows("2:14").Delete ' looks like you are only copying from row 14, which is row 15 in my code

'Add average.
Row = ActiveSheet.UsedRange.Rows.Count + 1
For i = 1 To Col - 1
    With Cells(Row, i)
    .Value = Application.WorksheetFunction.Average(Range(Cells(2, i), Cells(Row - 1, i)))
    .Font.Bold = True
End With