[решено] сохранение текстовых файлов (Excel)

[neprotiv]

доброго времени суток, господа
помогите, пожалуйста


нужен макрос который создавал бы текстовые файлы с названием из столбика 2, в которых будет текст из столбика 1.
есть два столбика

столбик 1 столбик 2
инфо1 01.01.2011
инфо2 01.01.2011
инфо3 01.01.2011
инфо4 01.02.2011
инфо5 01.02.2011

в итоге получаем файлы

01.01.2011.txt
инфо1
инфо2
инфо3

01.01.2011.txt
инфо4
инфо5

[neo21]

Макрос:
Sub пример()
'
' Запись первого файла
'
Dim a, b, c, d
a = Range("A1")
b = Range("A2")
c = Range("A2")
d = Range("B2")
Dim filesys, filetxt
Set filesys = CreateObject("Scripting.FileSystemObject")
Set filetxt = filesys.CreateTextFile("C:\" & d & ".txt")
filetxt.WriteLine (a)
filetxt.WriteLine (b)
filetxt.WriteLine (c)
filetxt.Close

' Запись второго файла
a = Range("A4")
b = Range("A5")
c = Range("B4")

Set filesys = CreateObject("Scripting.FileSystemObject")
Set filetxt = filesys.CreateTextFile("C:\" & c & ".txt")
filetxt.WriteLine (a)
filetxt.WriteLine (b)
filetxt.Close

End Sub

На диске C
создаются два файла:
01.01.2011.txt
01.02.2011.txt
таб:
http://i.piccy.info/i7/ec638ea67a9365812c188543506301bb/1-5-3158/51157102/1.jpg

[neprotiv]

спасибо большое

[neprotiv]

а что делать если количество строк неизвестно?
то что вы написали можно вручную сделать
а что делать если есть 365 дат и на каждую 100-500 записей?
спасибо

[Iska]

neprotiv, в предположении, что в таблице нет разрывов, можно попробовать так:
Sub Out()
Dim objFSO As New Scripting.FileSystemObject
Dim objRow As Range


For Each objRow In ActiveWorkbook.ActiveSheet.UsedRange.Rows
With objFSO.OpenTextFile(CStr(objRow.Cells.Item(1, 2).Value) & ".txt", ForAppending, True)
.WriteLine CStr(objRow.Cells.Item(1, 1).Value)
.Close
End With
Next
End Sub
В свойствах проекта нужно будет добавить (\Tools\References…) ссылку на библиотеку «Microsoft Scripting Runtime» («%SystemRoot%\system32\scrrun.dll»).

P.S. Если список гарантированно будет отсортирован по датам, то можно будет подумать и о том, чтобы не открывать/закрывать файл на каждую строку