用空行导入文本文件?
我正在使用下面的VBA代码来导入Excel中的多个文本文件。 但是,只要我的文本文件包含空行,内容就会被导入两行,而不仅仅是一行。 换句话说,我的文本文件中的每个空白行导致在导入过程中创build一个新行。
示例 – 这个示例文本应该导入到Excel中的一行中:
Lorem ipsum dolor sit amet,consectetuer adipiscing elit。 Aenean商品ligula eget dolor。 Aenean马萨。 Cum sociis natoque penatibus et magnis dis parturient montes,nascetur ridiculus mus。 Donec quam felis,ultricies nec,pellentesque eu,pretium quis,sem。
Nullainheritance了马萨诸塞州的森林。 Donec pede justo,fringilla vel,aliquet nec,vulputate eget,arcu。
但是,由于文本中有空行,因此会创build两行:
第1行:
Lorem ipsum dolor sit amet,consectetuer adipiscing elit。 Aenean商品ligula eget dolor。 Aenean马萨。 Cum sociis natoque penatibus et magnis dis parturient montes,nascetur ridiculus mus。 Donec quam felis,ultricies nec,pellentesque eu,pretium quis,sem。
第2行:
Nullainheritance了马萨诸塞州的森林。 Donec pede justo,fringilla vel,aliquet nec,vulputate eget,arcu。
VBA模块1:
Option Explicit Sub Sample() Dim myfiles As Variant Dim i As Integer Dim temp_qt As QueryTable Dim ws As Worksheet myfiles = Application.GetOpenFilename(filefilter:="Text files (*.txt), *.txt", MultiSelect:=True) If Not IsEmpty(myfiles) Then Set ws = Sheet1 For i = LBound(myfiles) To UBound(myfiles) Set temp_qt = ws.QueryTables.Add(Connection:= _ "TEXT;" & myfiles(i), Destination:=ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1, 0)) With temp_qt .Name = "Sample" .FieldNames = False .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = True .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 437 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = True .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With Next i Set temp_qt = Nothing CleanUpQT Else MsgBox "No File Selected" End If End Sub
VBA模块2:
Sub CleanUpQT() Dim connCount As Long Dim i As Long connCount = ThisWorkbook.Connections.Count For i = 1 To connCount ThisWorkbook.Connections.Item(i).Delete Next i End Sub
我怎样才能确保整个文本文件正确地导入到一行,而不是两个 – 不pipe它是否有空行?
实现这一点的一种方法是简单地将文本文件加载到内存中。 这种方法不会触发Excel的自动导入function,并且可以防止换行符将文档分成多行。
看下面的例子:
Sub Sample() Dim myFiles As Variant Dim i As Integer Dim ws As Worksheet Dim myData As String myFiles = Application.GetOpenFilename( _ filefilter:="Text files (*.txt),*.txt", _ MultiSelect:=True) If IsArray(myFiles) Then Set ws = Sheet1 For i = LBound(myFiles) To UBound(myFiles) Open myFiles(i) For Binary As #1 ' Open the file myData = Space$(LOF(1)) ' Allocate space for the file contents Get #1, , myData ' Read the file into the string Close #1 ' Close the file ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1, 0).Value = myData Next i Else MsgBox "No File Selected" End If End Sub