如何从 Excel 工作表导出 txt 文件而末尾不留空行？

Question

当我以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

Answer 1

以下功能将导出一个范围为文本文件，而末尾没有空白行。

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

请注意，如果范围仅包含单个单元格，则该函数将失败。一个人可以调整它，但我将其留给读者。

这就是您可以

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

在打印语句。特别是 charpos 参数是我们在这里需要的

charpos
指定下一个字符的插入点。 使用半隆在显示的最后一个字符之后立即将插入点放置。使用选项卡（n）将插入点定位到绝对列号。使用无参数的选项卡将插入点放置在下一个打印区域的开头。 下一个字符在下一行。

如果省略了charpos，则

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