макрос! с чего начать?!

[deemka777]

помогите написать макрос, который бы делал следующее:
столбец A2:A13 выводил в txt(1), и название брало из ячейки A1
и всё это в формате "форматированные текст(разделитель - пробел)"
столбец B2:B13 выводил в txt(второй), и название брало из ячейки B1
столбец C2:C13 выводил в txt(третий тхт), и название брало из ячейки C1
столбец D2:D13 выводил в txt(и четвёртый), и название брало из ячейки D1

после запуска, чтоб сохранялось 4 текстовых файла.

данные за 12 месяцев.

[EducatedFool]

Читаем это:
http://excelvba.ru/code/txt
http://excelvba.ru/code/Range2TXT

и пишем макрос:

sub test
папка = "C:\Documents and Settings\Admin\Рабочий стол\"
SaveTXTfile папка & [a1] & ".txt", Range2TXT([a2:a13], ""," ")
SaveTXTfile папка & [b1] & ".txt", Range2TXT([b2:b13], ""," ")
SaveTXTfile папка & [c1] & ".txt", Range2TXT([c2:c13], ""," ")
SaveTXTfile папка & [d1] & ".txt", Range2TXT([d2:d13], ""," ")
end sub

Function SaveTXTfile(ByVal filename As String, ByVal txt As String) As Boolean
    On Error Resume Next: Err.Clear
    Set fso = CreateObject("scripting.filesystemobject")
    Set ts = fso.CreateTextFile(filename, True)
    ts.Write txt: ts.Close
    SaveTXTfile = Err = 0
    Set ts = Nothing: Set fso = Nothing
End Function

Function Range2TXT(ByRef ra As Range, Optional ByVal ColumnsSeparator$ = vbTab, _
                   Optional ByVal RowsSeparator$ = vbNewLine) As String
    If ra.Cells.Count = 1 Then Range2TXT = ra.Value & RowsSeparator$: Exit Function
    If ra.Areas.Count > 1 Then
        Dim ar As Range
        For Each ar In ra.Areas
            Range2TXT = Range2TXT & Range2TXT(ar, ColumnsSeparator$, RowsSeparator$)
        Next ar
        Exit Function
    End If
    arr = ra.Value
    For i = LBound(arr, 1) To UBound(arr, 1)
        txt = "": For j = LBound(arr, 2) To UBound(arr, 2): txt = txt & ColumnsSeparator$ & arr(i, j): Next j
        Range2TXT = Range2TXT & Mid(txt, Len(ColumnsSeparator$) + 1) & RowsSeparator$
    Next i
End Function

[IgorGO]

Sub ToTxt()
  For c = 1 To 4
    Open Cells(1, c) For Output As #1
    For r = 2 To 13
      Print #1, Cells(r, c)
    Next
    Close #1
  Next
End Sub

[deemka777]

спасибо, и спасибо что так быстро!
у меня только ещё один нюанс, по поводу отображения в txt.
данные все в строчку получились. наверное я не тот формат указал?(т.е. txt но с другим параметром)
т.е. в txt хотел видеть приблизительно так.

    12
    89
    67
...
  240

[EducatedFool]

в строках типа этой внесите изменения:
SaveTXTfile папка & [a1] & ".txt", Range2TXT([a2:a13])

уберите всё после адреса диапазона (и до скобки)

PS: сами же просили разделитель "пробел" - а сейчас без пробелов просите)

[IgorGO]

что-то мне не интересно проверять, то что я написал. как оказалось - и Вам то же. на сколько я понимаю, все именно так и должно получиться, каждое значение в новой строке.
успехов!

[deemka777]

IgorGO, если бы я ещё и понимал.

EducatedFool, спасибо ещё раз.
я почему так написал, если эксель сохранить как, и выбрать "форматированные текст(разделитель - пробел)" то получится то что мне надо. но только он сохранит в формате .prn, а если переименовать в txt, я получаю то что мне надо.

п.с. в итоге немного не то, чего я добивался.
это реально так сделать?

      12
      89
      67
...
    240

как в коде, с отступом от левой стороны, но так что бы ровно по правой.

[EducatedFool]

если эксель сохранить как, и выбрать "форматированные текст(разделитель - пробел)" то получится то что мне надо

ну так запишите макрорекордером код сохранения в prn
и покажите, что получилось

а мы этот код дополним переименованием в txt

это реально так сделать?

всё реально
просто вы сразу не сказали, что надо добавлять пробелы

сами подумайте, откуда могут быть разделители, если числа берутся из ОДНОГО столбца...

или они у вас в ячейках так и забиты, с пробелами?

да и зачем вообще это надо - добавлять перед числами пробел?

[deemka777]

не знаю, правельно ли я сделал

Sub Макрос1()
'
' Макрос1 Макрос
' Макрос записан 22.02.2011 (Dmitriy)
'

'
    ChDir "D:\"
    ActiveWorkbook.SaveAs filename:="D:\Лист Microsoft Excel.prn", FileFormat:= _
        xlTextPrinter, CreateBackup:=False
End Sub

[IgorGO]

Игорь, это надо для красоты...)))
проверил, работает... как и предполагалось
вот так с лидирующими пробелами:

Sub ToTxt()
  For c = 1 To 4
    Open Cells(1, c) For Output As #1
    For r = 2 To 13
      Print #1, Format(Cells(r, c), "@@@@@")
    Next
    Close #1
  Next
End Sub