我编写了一个visual basic宏来将csv文件加载到我经常使用的Excel中。
不幸的是,如果csv文件包含引用的换行符,则结果与使用excel直接打开csv文件时的结果不同。与通常的导入工具不同,QueryTables.add()
假定它遇到的任何换行符,无论是否引用,都是该行的结尾。
有解决方法吗?我更喜欢不涉及预先修改传入的csv文件的解决方案以删除换行符,但我也可以在这方面接受建议。不过,我确实希望在生成的excel文件单元格中有换行符。
我的宏的相关部分:
Sub LoadMyFile()
' Query the table of interest
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" _
& ThisWorkbook.Path & "\" & Range("A1").Value & ".csv", _
Destination:=Range("$A$2"))
.Name = ActiveSheet.Name
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
这是一个带引号换行符的示例csv文件
"firstCol","secondCol"
"name1","data
one"
"name
2","data two"
宏从单元格A1读取文件名(减去.csv扩展名),并假定csv文件与包含宏的excel文件位于同一目录中。
我在Windows 7计算机上使用32位Office Professional 2010。
答案 0 :(得分:3)
导入此类CSV文件(数据点中的换行符)仅适用于Workbooks.Open,并且只能使用区域设置格式的CSV(分隔符,文本分隔符),使用Excel。
Set wb = Workbooks.Open(Filename:="C:\Users\axel\Desktop\test.csv", Local:=True)
aData = wb.Worksheets(1).UsedRange.Value
lRows = UBound(aData, 1)
lCols = UBound(aData, 2)
With ActiveSheet
.Range(.Cells(1, 1), .Cells(lRows, lCols)).Value = aData
End With
wb.Close
问候
阿克塞尔
答案 1 :(得分:1)
编辑:以前提供的代码实际上是根据您提供的具体示例设计的,在源CSV中有2列和相对较少的数据。我已经回顾了下面的代码以适应其他可能的场景 - 还包括对运行时效率的一些优化。
注意我不习惯使用与我在这里依赖的Open方法相关的搜索工具,我仍然有一些疑虑,就像他们在某些情况下的实际工作方式一样,但在运行了几个测试之后代码看起来工作正常。
Sub csvImportbis()
Dim s As String
Dim i As Long
Dim j As Long
Dim a() As String
myfile = FreeFile
i = 1
j = 1
'ENTER YOUR PATH/FILE NAME HERE
Open "YOUR_PATH/FILENAME" For Input As #myfile
Do Until EOF(myfile)
Do
Input #myfile, s
cur = Seek(myfile)
Seek myfile, cur - 1
i = i + 1
Loop While input(1, #myfile) <> vbLf
ReDim a(1 To i - 1, 1 To 10000)
i = 1
Seek #myfile, 1
Do Until EOF(myfile)
Input #myfile, a(i, j)
i = i + 1
If i > UBound(a, 1) Then
i = 1
j = j + 1
End If
If j > UBound(a, 2) Then
ReDim Preserve a(1 To UBound(a, 1), 1 To UBound(a, 2) + 10000)
End If
Loop
Loop
Close #myfile
sup = j
ReDim Preserve a(1 To UBound(a, 1), 1 To sup)
'QUALIFY THE RANGE WITH YOUR WORKBOOK & WORKSHEET REFERENCES
Range("A1").Resize(sup, UBound(a, 1)) = WorksheetFunction.Transpose(a)
End Sub