使用VBA,快速导入CSV文件内容到EXCEL表格
前几日遇到一个将几十个商品二维码数据文件导入到EXCEL中,做格式转换再导入数据库的问题。拿到的原始表格是将近100个CSV格式的文本文件,每个文件中大概有几万到十几万行数据不等。这么大量的数据,手工处理太浪费时间,于是就想用VBA写个脚本导进来。VBA读取CSV文件到表格中也是一种比较常见的需求,可以用Scripting.FileSystemObject对象来进行操作,只要掌握FileSystemObject对象的用法即可。
其实Excel本身就具有数据查询和导入的功能,可以获取多种格式的数据(结构化数据),是否可以利用这个功能,结合VBA脚本,快速实现文件导入呢?经过验证是可行的。
获取数据首先新建一个空Excel文件,希望能通过尽可能少手动操作,把数据读进来。那么首先得知道有多少个文件,每个文件的名字是什么,这就用到VBA脚本了。使用用ALT+F11打开VBA编辑器,新建一个模块,先建一个读取文件名的过程。
Sub sfiles()
Dim s As FileSearch '定义一个文件搜索对象
Dim fpath As String '定义一个文件路径
Dim fl As Worksheet
Set fl = ThisWorkbook.Worksheets("filelist")
fpath = ThisWorkbook.Path
fpath = fpath & "\要读取文件的文件夹\"
n = 1
myFile = Dir(fpath & "*.*")
Do While myFile <> ""
fl.Cells(n, 1) = myFile
myFile = Dir '找寻下一个文件
n = n + 1
Loop
End Sub
运行这段脚本,就可以把要读取的文件名写入第一个Sheet中了。接下来要做的,就是按照文件名,依次把文件内容读到当前的Excel文件中,每个文件的数据存入一个新的Sheet中。
如果对于Excel导入数据的VBA写法很熟悉的话,可以直接写脚本,如果不熟也没关系,先录制一个宏,然后修改即可。最终完成的过程如下:
Sub importDatafromCsv()
'从CSV文件中批量读入数据到表格
'
Dim filelists As Worksheet
Dim fileNum As Integer
Dim aimFileName As String
Dim aimFile As String
Dim aimFileFullPath As String
Dim sheetNum As Integer
Dim i As Integer
Set filelists = ThisWorkbook.Worksheets("filelist")
fileNum = filelists.[A1].CurrentRegion.Rows.Count '取行数
For i = 1 To fileNum
'aimFile = Selection.Value ‘可以选中一个文件名,然后导入,或者按下面的循环,一次导入所有
aimFile = filelists.Cells(i, 1).Value
aimFileName = Split(aimFile, ".", , vbTextCompare)(0)
aimFileFullPath = ThisWorkbook.Path & "\导入文件所在文件夹\" & aimFile
sheetNum = ThisWorkbook.Sheets.Count
ThisWorkbook.Sheets.Add(After:=Sheets(sheetNum)).Name = "new" & sheetNum + 1
Range("A1").Select
ActiveWorkbook.Queries.Add Name:=aimFileName, Formula:= _
"let" & Chr(13) & "" & Chr(10) & " 源 = Csv.Document(File.Contents(""" & aimFileFullPath & """),[Delimiter="","", Columns=5, Encoding=936, QuoteStyle=QuoteStyle.None])," & Chr(13) & "" & Chr(10) & " 更改的类型 = Table.TransformColumnTypes(源,{{""Column1"", Int64.Type}, {""Column2"", type text}, {""Column3"", type text}, {""Column4"", Int64.Type}, {" & _
"""Column5"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " 更改的类型" & _
""
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & aimFileName & ";Extended Properties=""""", Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [" & aimFileName & "]")
.rownumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = aimFileName
.Refresh BackgroundQuery:=False
End With
ActiveSheet.ListObjects(aimFileName).Unlink
Range("A1").Select
Next
End Sub
运行以上脚本,大概几分钟,所有近100个文件,将近100万行数据全部导入Excel表格,接下来再做其他处理就方便多了。
如有人也遇到类似的问题,可以尝试用上面的方法解决,大大节省时间,提高效率。如果有更好、更高效的方法也欢迎一起交流。