сохранение файла Excel в виде текстового файла с разделителями табуляции без кавычек - PullRequest
Новая
       29

сохранение файла Excel в виде текстового файла с разделителями табуляции без кавычек

1 голос
/ 31 января 2012

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

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

Я бы предпочел сделать это, используя код VBA из Excel.

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

1 Ответ

1 голос
/ 31 января 2012

Хорошо, это немного сложная процедура, которую я написал пару месяцев назад для одного из моих клиентов. Этот код экспортирует рабочую таблицу 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

enter image description here

...