将excel文件保存为制表符分隔的文本文件,不带引号

时间:2012-01-31 00:47:40

标签: excel-vba pywin32 vba excel

我有一个Excel 2010工作簿。我需要将每个工作表的使用范围保存为制表符分隔的文本文件,不带引号,文件名与工作簿相同,并带有工作表名称给出的扩展名。

请注意,只要Excel看到逗号,Excel就会用引号愚蠢地围绕一个值,即使分隔符是一个制表符;除此之外,正常的“另存为”/“文本(制表符分隔)”没问题。

我更喜欢在Excel中使用VBA代码。

如果有Python解决方案,我也会感兴趣。但是在这一点上pywin32对Python 3的支持只是实验性的,所以我不确定我是否可以使用它。

2 个答案:

答案 0 :(得分:1)

好的,这是一个稍微复杂的例行程序,我几个月前为我的一位客户写了一篇文章。此代码将Excel工作表导出到固定宽度文件而不使用QUOTES 。截图也附上。我相信这段代码可以做得更好:)

尝试和测试

Option Explicit

'~~> Change this to relevant output filename and path
Const strOutputFile As String = "C:\Output.Csv"

Sub Sample()
    Dim ws As Worksheet
    Dim rng As Range
    Dim MyArray() As Long, MaxLength As Long
    Dim ff As Long, i As Long, lastRow As Long, LastCol As Long
    Dim strOutput As String

    On Error GoTo Whoa

    Application.ScreenUpdating = False

    '~~> Change this to the respective sheet
    Set ws = Sheets("Sheet1")
    LastCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column

    '~~> Loop through each Column to get the max size of the field
    For i = 1 To LastCol
        MaxLength = getMaxLength(ws, i)
        ReDim Preserve MyArray(i)
        MyArray(i) = MaxLength
    Next i

    ff = FreeFile

    '~~> output file
    Open strOutputFile For Output As #ff

    '~~> Write to text file
    With ws
        lastRow = .Range("A" & Rows.Count).End(xlUp).Row

        For Each rng In .Range("A1:A" & lastRow)
            With rng
                For i = 1 To UBound(MyArray)
                    '~~> Insert a DELIMITER here if your text has spaces
                    strOutput = strOutput & " " & Left(.Offset(0, i-1).Text & _
                                String(MyArray(i), " "), MyArray(i))
                Next i

                Print #ff, Mid(Trim(strOutput), 1)
                strOutput = Empty
            End With
        Next rng
    End With

LetsContinue:
    On Error Resume Next
        Close #ff
    On Error GoTo 0
    Application.ScreenUpdating = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

'~~> Function to get the max size
Public Function getMaxLength(ws As Worksheet, Col As Long) As Long
    Dim lastRow As Long, j As Long

    getMaxLength = 0

    lastRow = ws.Range("A" & ws.Rows.Count).End(-4162).Row

    For j = 1 To lastRow
        If Len(Trim(ws.Cells(j, Col).Value)) > getMaxLength Then _
        getMaxLength = Len(Trim(ws.Cells(j, Col).Value))
    Next j
End Function

enter image description here

答案 1 :(得分:0)

打开您的excel / csv / text 执行所需的操作,然后可以使用文件格式另存为xlTextPrinter

ActiveWorkbook.SaveAs文件名:=“您的文件名.txt”,文件格式:= xlTextPrinter,创建备份:=假

不需要额外的代码来替换额外的引号