制表符分隔空单元格的已保存文件缺少选项卡

时间:2018-06-14 12:31:05

标签: excel vba tabs export delimited-text

我在excel vba中编写代码来转换数据并保存为制表符分隔的txt文件。所有字段都导出正常,但如果a列中没有数据,则不会在保存的文件中插入选项卡

  'Exporting Sheet as Tab Delimited Text File To Target Path
ActiveSheet.SaveAs Filename:=SavePath & WS.Name, FileFormat:=xlTextWindows

这是导出/保存文件的代码。

源数据在列

中列出如下
A     B     C     D     E

使用B和C中的数据 - 我希望生成的文件格式为

TAB   B/TAB   C/TAB   TAB   TAB

我试图将相关单元格中的字符写入以下内容无效 - 因为它只插入2个x标签

Cells(t, 1) = Chr(11)

T上的循环数为行数

1 个答案:

答案 0 :(得分:0)

此过程将创建一个CSV文件,包括空白列,范围从A1到UsedRange的右下角:

Sub makeCSV()
    Const outFile = "C:\yourpath\output.csv"
    Dim ws As Worksheet: Set ws = Sheets("Sheet1")
    Dim rgExport As Range, c As Variant, v As String, strOut As String

    'figure out range: from A1 to bottom-right of 'UsedRange'
    Set rgExport = ws.Range("$A$1:" & Split(ws.UsedRange.Address, ":")(1))

    'parse range
    For Each c In rgExport
        'if the cell contains a comma put quotes around it
        If InStr(c, ",") <> 0 Then v = """" & c & """" Else v = c
        'add cell to output string
        If c.Column = rgExport.Columns.Count Then
            'last column in range: add CR+LF
            strOut = strOut & v & vbCrLf
        Else
            'not last column: add a comma
            strOut = strOut & v & ","
        End If
    Next c

    'create text file (will overwrite if it already exists)
    Open outFile For Output As #1
    Print #1, strOut
    Close #1

    Debug.Print "Exported " & rgExport.Address & " to " & outFile
    MsgBox "Exported " & rgExport.Address & " to " & outFile

End Sub

更改过程顶部的输出文件名和源表名称。

或者,您可以通过用这些<替换第一个三个行来更改从不同输入表导出到不同输出文件的过程<强>两个行:

Sub makeCSV(sheetName as String, outFile as String)
    Set ws = Sheets(sheetName)

...然后将其称为:

makeCSV "Sheet1", "c:\yourPath\output.csv"