сохранение файла excel в виде текстового файла с разделителями-запятыми без кавычек

Question

У меня есть книга Excel 2010. Мне нужно сохранить используемый диапазон каждого из своих листов в виде текстового файла с разделителями табуляции без кавычек с тем же именем файла, что и книга, и с расширением, заданным именем рабочего листа.

Обратите внимание, что Excel тупо окружает значение кавычками всякий раз, когда видит запятую, хотя разделитель является вкладкой; кроме этого, нормальный «Сохранить как»/«Текст (разделитель табуляции)» будет в порядке.

Я бы предпочел сделать это с помощью кода VBA из Excel.

Если есть решение Python, мне тоже будет интересно. Но на данный момент поддержка pywin32 для Python 3 только экспериментальная, поэтому я не уверен, что смогу ее использовать.

Answer 1

Хорошо, вот немного сложная процедура, которую я написал пару месяцев назад для одного из моих клиентов. Этот код экспортирует рабочий лист Excel в файл фиксированной ширины без котировок. Скриншоты также прилагаются. Я уверен, что этот код может быть даже лучше :)

испытанный

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