Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Сохранить каждую строку в отдельный файл (макрос)
 
#1
04.05.2011 23:51:16
Доброго времени суток. В VB не очень силен, посему прошу помощи.  
Есть на листе 50 столбцов, 5000 строк (эти данные примерно названы, они каждый раз будут разными, может быть и 100, а может и 100000). Нужно каждую строку считать и записать в отдельный файл с названием, которое содержится в первом столбце. Примерный макет может кто подкинет, я допилю. Спасибо.
 
 
 
#2
05.05.2011 00:06:56
Option Explicit  
 
 
Sub tt()  
   Dim i As Long  
   Dim ws As Worksheet  
 
   With Application  
       .DisplayAlerts = False  
       .ScreenUpdating = False  
       Set ws = ActiveSheet  
 
       For i = 1 To Range("A" & Rows.Count).End(xlUp).Row  
 
           With Workbooks.Add  
               ws.Rows(i).Copy .Worksheets(1).Range("A1")  
               .SaveAs ThisWorkbook.Path & "\" & .Worksheets(1).Range("A1")  
               .Close 0  
           End With  
 
       Next  
 
       .DisplayAlerts = True  
       .ScreenUpdating = True  
   End With  
End Sub
 
 
 
#3
05.05.2011 00:27:14
Раз уж сделал:-)  
Public Sub www()  
   Dim c As Range  
   For Each c In ActiveSheet.Range(ActiveSheet.[a1], ActiveSheet.Cells(Rows.Count, 1).End(xlUp)).Cells
       With Workbooks.Add  
           Range(c, c.Offset(, 50)).Copy .Sheets(1).[a1]
           .SaveAs (ThisWorkbook.Path & "\" & c.Value)  
           .Close  
       End With  
   Next  
End Sub
Я сам - дурнее всякого примера! ...
 
 
 
#4
05.05.2011 01:48:28
100000 файлов - это круто!  
на продажу или для себя?
 
 
 
#5
05.05.2011 09:13:58
Кстати да, если файлов много - стоит в мой вариант добавить вывод в статусбар количество несгенерённых файлов, а в код Сергея - наоборот :)
 
 
 
#6
05.05.2011 13:30:59
{quote}{login=offtop}{date=05.05.2011 01:48}{thema=}{post}100000 файлов - это круто!  
на продажу или для себя?{/post}{/quote}  
Только для себя.  
 
Спасибо всем! Несколько вариантов уже точно не ожидал. Как можно сделать чтобы данные писались не в книги, а в текстовый файл, причем между каждой ячейкой должен быть перенос строки:  
cell_1  
cell_2  
cell_3  
...
 
 
 
#7
05.05.2011 13:42:22
Да в общем оба варианта выше одинаковые.  
Писать в текст - это будет на порядок быстрее.  
Сразу берём диапазон в массив, затем цикл по массиву, цикл по строке массива и WriteLine или Print в новый текстовый файл.  
В коде сейчас изображать некогда.
 
 
 
#8
05.05.2011 13:51:16
Пробуйте  
 
Sub artlayers()  
Dim c As Range, d As Range  
For Each c In ActiveSheet.UsedRange.Columns(1).SpecialCells(xlCellTypeConstants)  
   Open ThisWorkbook.Path & "\" & c & ".txt" For Output As #1  
   For Each d In Range(c, Cells(c.Row, Columns.Count).End(xlToLeft))  
       Print #1, d  
   Next  
   Close #1  
Next  
End Sub
 
 
 
#9
05.05.2011 18:24:16
{quote}{login=Казанский}{date=05.05.2011 01:51}{thema=}{post}Пробуйте  
 
Sub artlayers()  
Dim c As Range, d As Range  
For Each c In ActiveSheet.UsedRange.Columns(1).SpecialCells(xlCellTypeConstants)  
   Open ThisWorkbook.Path & "\" & c & ".txt" For Output As #1  
   For Each d In Range(c, Cells(c.Row, Columns.Count).End(xlToLeft))  
       Print #1, d  
   Next  
   Close #1  
Next  
End Sub{/post}{/quote}  
 
Отлично! Спасибо, это как раз то что надо. Можно ли писать не все строки, а только которые видны (например, скрытые через фильтры не брать). Какое свойство от строки скажет что она не активная? Если это сильно усложняет макрос, то не нужно.
 
 
 
#10
05.05.2011 18:33:06
Не сильно :)  
просто допишите еще один спешиалселлз:  
 
For Each c In ActiveSheet.UsedRange.Columns(1).SpecialCells(xlCellTypeConstants).SpecialCells(xlCellTypeVisible)  
 
Собсно, SpecialCells(xlCellTypeConstants) нужен для того, чтобы пропускать пустые ячейки. Если их нет, можно эту часть исключить.
 
 
 
Страницы: 1
Читают тему
Наверх