如何从 Excel sheet 中导出一个 txt 文件而末尾没有空行?

How can I export a txt file from an Excel sheet without having a blank line at the end?

当我将 sheet 导出为 txt 时,它会在末尾生成一个空行。

我需要什么

我使用此代码来检测使用范围并仅导出该范围。需要打开包含要复制的数据的工作簿。

Sub export_range_txt()
    
    Workbooks.Add
    y = ActiveWorkbook.Name
    'insert the name of the workbook were data is been copied and create  this sub there
    Windows("original.xlsm").Activate 
    ActiveSheet.Activate
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row 
    Range("A1:Y" & LastRow).Copy
    Windows(y).Activate
    ActiveSheet.Activate
    Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    
    Application.DisplayAlerts = False

    'change path to desired location of the txt file
    ActiveWorkbook.SaveAs Filename:= _
      "path\test.txt", FileFormat:=xlText, _
      CreateBackup:=False

    ActiveWindow.Close
    Application.DisplayAlerts = True

End Sub

以下函数会将范围导出到文本文件,最后没有空行。

Function exportRgToTxt(rg As Range, filename As String)

    ' use a semicolon as a column separator, adjust accordingly or use a parameter
    Const SEPARATOR = ";"

    Dim i As Long, j As Long
    Dim vdat As Variant, vRow As Variant
        
    ' Placing the values of the range into an array
    vdat = rg.Value

    Dim txtFile As Long
    txtFile = FreeFile
    Open filename For Output As txtFile
        
    ' Write each row of the range to the text file but the last one
    For i = LBound(vdat, 1) To UBound(vdat, 1) - 1
        vRow = Application.WorksheetFunction.Index(vdat, i, 0)  ' Get the i-th row of the array
        vRow = Join(vRow, SEPARATOR)
        Print #txtFile, vRow   ' This will add a CRLF at the end of the line
    Next i
    
    ' Write Last row without an CRLF
    vRow = Application.WorksheetFunction.Index(vdat, UBound(vdat, 1), 0)
    vRow = Join(vRow, SEPARATOR)
    Print #txtFile, vRow; ' the semicolon will avoid the CRLF at the end of the file
    Close txtFile

End Function

请注意,如果范围仅包含单个单元格,该函数将失败。可以调整它,但我将其留给 reader.

这就是您可以测试的方式

Sub testit()
    exportRgToTxt Range("A1").CurrentRegion, "D:\tmp\abc.txt"
End Sub

进一步阅读 Print Statement。特别是charpos参数是我们这里需要的

charpos
指定下一个字符的插入点。 使用分号将插入点紧跟在显示的最后一个字符之后。使用 Tab(n) 将插入点定位到绝对列号。使用不带参数的 Tab 将插入点定位在下一个打印区域的开头。 如果省略charpos,下一个字符打印在下一行

请参阅下文如何使用 OP 代码中的函数

Sub export_range_txt()
    
    Workbooks.Add
    y = ActiveWorkbook.Name
    'insert the name of the workbook were data is been copied and create  this sub there
    Windows("original.xlsm").Activate
    ActiveSheet.Activate
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    
    'Range("A1:Y" & LastRow).Copy  ' this line is not needed any longer
    
    ' Here you could use the exportRgToTxt instead
    exportRgToTxt Range("A1:Y" & LastRow), "<your file name>"
    
    
    ' the remaining code is not neccessary
'    Windows(y).Activate
'    ActiveSheet.Activate
'    Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
'
'
'
'    Application.DisplayAlerts = False
'    ActiveWorkbook.SaveAs Filename:= _
'   'change path to desired location of the txt file
'        "path\test.txt", FileFormat:=xlText, _
'    CreateBackup:=False
'    ActiveWindow.Close
'    Application.DisplayAlerts = True

End Sub