Из XL в txt

[Starik]

Как перебросить данные из таблицы XL в файл txt, но так, чтобы каждый столбец в файле txt отделялся только точкой с запятой (;) ?

[GSerg]

С этим делом у экселя проблемы, зависящие от его версии...
Попробуй просто "Сохранить как текст", не исключено, что получится

[Starik]

Мне без разницы каким методом сделать из VBA или VB.
А если таблицу слить в List, а от туда в txt?

[Starik]

Хорошо, тогда пойду другим путем, как мне перенести данные записанные в List, который имеет несколько столбцов, перенести в txt файл столбцами и чтобы там столбцы отделялись точкой с запятой.
Или как в таблице XL в каждой ячейки, после данных, поставить точку с запятой?

[Димитрий]

Может быть поможет такой макрос:

Код: Выделить всё

Sub vText()
On Error GoTo ErrLabel
Dim Rg As Range, strFileName As String, Stroka As String
Dim i As Long, j As Long, maxColumn As Long, maxRow As Long
    Set Rg = Application.InputBox(Prompt:= _
        "Выделите регион для переноса в текстовый файл", _
        Title:="vText", Type:=8)
    With Rg
        maxColumn = .Columns.Count
        maxRow = .Rows.Count
        strFileName = Application.GetSaveAsFilename(InitialFileName:="New", _
            FileFilter:="Текстовый файл,*.txt", _
            Title:="Сохранить регион как текстовый файл...")
        If strFileName = "False" Then Exit Sub
        If Dir(strFileName) <> vbNullString Then
            If MsgBox("Файл с таким именем существует. Переписать его?", _
                vbYesNo, "vText") = vbNo Then Exit Sub
        End If
        Open strFileName For Output As #1
            For i = 1 To maxRow
                Stroka = vbNullString
                For j = 1 To maxColumn
                    Stroka = Stroka & .Cells(i, j).Value & ";"
                Next
                Print #1, Stroka
            Next
        Close #1
    End With
Exit Sub
ErrLabel:
    If Err.Number = 424 Then
        MsgBox "Ошибка в выделении региона"
    Else: MsgBox "Ошибка  " & Err.Number & vbCrLf & Err.Description
    End If
End Sub


[Starik]

Димитрий, Огромное тебе спасибо!!!

Это то, что нужно. Я уже стал изощряться через VB, но получается слишком мудрено.

А интересно, в txt файле можно выровнить данные по столбцам?

[Димитрий]

Для красоты?
Можно. Если длинна данных в ячейках не сильно различается, замени строку:

Код: Выделить всё

Stroka = Stroka & .Cells(i, j).Value & ";" & vbTab

Если сильно, то вставь перед Open:

Код: Выделить всё

ReDim lMass(1 To maxColumn) As Long
        For j = 1 To maxColumn
            For i = 1 To maxRow
            If lMass(j) < Len(.Cells(i, j).Value) Then lMass(j) = _
               Len(.Cells(i, j).Value)
            Next
        Next

И строка:

Код: Выделить всё

Stroka = Stroka & .Cells(i, j).Value & ";" & Space(lMass(j) - Len(.Cells(i, j).Value))

Не забудь в блокноте поставить моноширинный шрифт (например - Courier)

[Starik]

Димитрий, спасибо.
Обязательно попробую, но завтра, сегодня.....

[Starik]

Димитрий, не удержался, попробовал, отлично, читаемость стала хорошей.