Question

我使用以下VBA代码在Excel中导入多个文本文件。但是，只要我的文本文件包含空行，内容就会导入到两行中，而不只是一行。换句话说，我的文本文件中的每个空行都会导致在导入过程中创建一个新行。

示例 - 此示例文本应导入Excel中的一个行：

Lorem ipsum dolor坐下来，这是一种不可或缺的精神。 Aenean   Philao ligula eget dolor。 Aenean massa。 Cum sociis natoque penatibus   et magnis dis parturient montes，nascetur ridiculus mus。 Donec quam   felis，ultricies nec，pellentesque eu，pretium quis，sem。

Nulla consequat massa quis enim。 Donec pede justo，fringilla vel，   alquet，neputate eget，arcu。

但是，由于文本中有空行，因此会创建两个行：

第1行：

Lorem ipsum dolor坐下来，这是一种不可或缺的精神。 Aenean Philao ligula eget dolor。 Aenean massa。 Cum sociis natoque penatibus et magnis dis parturient montes，nascetur ridiculus mus。 Donec quam felis，ultricies nec，pellentesque eu，pretium quis，sem。

第2行：

Nulla consequat massa quis enim。 Donec pede justo，fringilla vel， alquet，neputate 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

如何确保将整个文本文件正确导入一行而不是两行 - 无论其中是否有空行？

Answer 1

实现此目的的一种方法是简单地将文本文件加载到内存中。此方法不会触发Excel的自动导入功能，并允许您阻止换行符将文档拆分为多行。

请参阅以下示例：

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

用空行导入文本文件？

1 个答案: