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

时间:2016-06-15 07:45:01

标签: excel-vba csv macros excel-2010 vba

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

起始单元格已知,但列范围的大小可能会有所不同。

每个文件名都不同。

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

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

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

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

我设法创建了一个宏,它将查找并遍历所有csv文件,并选择并复制相关的数据范围,但是我在主工作簿中粘贴它时遇到了麻烦,而没有使用“激活”和“选择” ”。它还会跳过A列并粘贴到B列。

另外,如果没有按顺序打开和关闭每个csv文件,我还没有工作。

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

现行守则:     选项明确     Sub Import()

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

1 个答案:

答案 0 :(得分:0)

以下是一些代码,您可以修改这些代码以直接将数据读入主数据库而无需打开每个文件。

'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
相关问题