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

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)

- Программирование и базы данных (http://forum.oszone.net/forumdisplay.php?f=21)

- - [решено] сохранение текстовых файлов (Excel) (http://forum.oszone.net/showthread.php?t=222868)

neprotiv

14-12-2011 07:02 1814850

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

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

нужен макрос который создавал бы текстовые файлы с названием из столбика 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

27-12-2011 19:15 1823572

Макрос:

Код:

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
таб:

neprotiv

28-12-2011 02:35 1823845

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

neprotiv

28-12-2011 03:07 1823855

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

Iska	28-12-2011 08:54 1823946

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. Если список гарантированно будет отсортирован по датам, то можно будет подумать и о том, чтобы не открывать/закрывать файл на каждую строку

Время: 13:47.