我正在尝试在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
答案 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