VBA代码将Excel表格保存为制表符分隔的文本文件

Question

我找到了这段代码并尝试运行它，它可以正常工作，但是保存的文本文件中第一列有空格（所有行都有）。我无法修复这个问题。

Sub ExportRange()
Dim ExpRng As Range
Open ThisWorkbook.Path & "\AllDXL.txt" For Output As #1
Set ExpRng = Worksheets("Sheet1").Range("A1").CurrentRegion
FirstCol = ExpRng.Columns(1).Column
LastCol = FirstCol + ExpRng.Columns.Count - 1
FirstRow = ExpRng.Rows(1).Row
LastRow = FirstRow + ExpRng.Rows.Count - 1
For r = FirstRow To LastRow
 Data = ""
 For c = FirstCol To LastCol
  '  data = ExpRng.Cells(r, c).Value
  Data = Data & vbTab & ExpRng.Cells(r, c).Value
Next c
Print #1, Data
Next r
Close #1
End Sub

- Siraj

Answer 1

希望这能帮助某些人节省时间：

Sub ExportToTxt()
    Dim fileStream As Object
    Set fileStream = CreateObject("ADODB.Stream")
    fileStream.Charset = "utf-8"
    fileStream.Open
    
    ' set the range you'd like to export
    Dim rangeToExport As Range
    Set rangeToExport = Worksheets("BPC-Processed").Range("A1").CurrentRegion
    
    Dim firstCol, lastCol, firstRow, lastRow As Integer
    firstCol = rangeToExport.Columns(1).Column
    lastCol = firstCol + rangeToExport.Columns.Count - 1
    firstRow = rangeToExport.Rows(1).row
    lastRow = firstRow + rangeToExport.Rows.Count - 1
    
    ' iterate the range, write text to stream
    Dim r, c As Integer
    Dim str, delimiter As String
    For r = firstRow To lastRow
        str = ""
        For c = firstCol To lastCol
            If c = 1 Then
                delimiter = ""
            Else
                delimiter = vbTab ' tab
            End If
            str = str & delimiter & rangeToExport.Cells(r, c).Value
        Next c
        fileStream.WriteText str & vbCrLf ' vbCrLf: linebreak
    Next r
    
    ' flush stream
    Dim filePath As String
    filePath = Application.ThisWorkbook.Path & "\BPC-Processed.txt"
    fileStream.SaveToFile filePath, 2 ' 2: Create Or Update
    fileStream.Close
End Sub

- Rohim Chou

Answer 2

此外，这也有效...

Sub ExportRange()
Dim ExpRng As Range
Dim myTab As String
Open ThisWorkbook.Path & "\AllDXL.txt" For Output As #1
    Set ExpRng = Worksheets("Sheet1").Range("A1").CurrentRegion
    FirstCol = ExpRng.Columns(1).Column
    LastCol = FirstCol + ExpRng.Columns.Count - 1
    FirstRow = ExpRng.Rows(1).Row
    LastRow = FirstRow + ExpRng.Rows.Count - 1
    For r = FirstRow To LastRow
       Data = ""
       For c = FirstCol To LastCol
           If c = 1 Then myTab = "" Else myTab = vbTab
        '  data = ExpRng.Cells(r, c).Value
           Data = Data & myTab & ExpRng.Cells(r, c).Value
       Next c
       Print #1, Data
   Next r
Close #1
End Sub

- MiguelH

Answer 3

你正在为每个单元格添加一个 vbTab 前缀，包括第一个。请更改以下内容：

Data = Data & vbTab & ExpRng.Cells(r, c).Value

到

If c = FirstCol Then
    Data = Data & ExpRng.Cells(r, c).Value
Else
    Data = Data & vbTab & ExpRng.Cells(r, c).Value
End If

如果每行始终会有一些数据，您可以在打印阶段通过以下方式从每行中删除第一个 vbTab：

更改为：

Print #1, Data

到

Print #1, Mid(Data, 2, Len(Data)-1)

- CLR

---

感谢CLR，Print＃1，Mid（Data，2，Len（Data）-1）导致省略第一列数据中的第一个字符。我将其更改为Print＃1，Mid（Data，1，Len（Data）-1），它起作用了。谢谢 - Siraj

你不会同时使用我的两个答案，对吧？你只需要其中一个。如果你使用第一个（带有IF ELSE THEN结构），那么你就不需要更改Print。如果你同时使用两个但将Print部分更改为Print＃1，Mid（Data，1，Len（Data）-1），则会丢失每行的最后一个字符。 - CLR

太好了，谢谢CLR。 - Siraj