Форум программистов
 
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

Вернуться   Форум программистов > Microsoft Office и VBA > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail


Донат для форума - использовать для поднятия настроения себе и модераторам

А ещё здесь можно купить рекламу за 25 тыс руб в месяц! ) пишите сюда - alarforum@yandex.ru

Ответ
 
Опции темы
Старый 13.03.2010, 16:23   #1
provodnikam
Пользователь
 
Регистрация: 17.07.2009
Сообщений: 31
Репутация: 10
Восклицание Разделить файл на несколько частей

Здравствуйте!!!!
Подскажите, пожалуйста, как программно сделать вот такую процедурку:
имеется файл Excel
состоит из 4 столбцов и 20 000 строк
Необходимо макросом разбить его на части по 500 строк каждый.
после разбивки должно получиться 40 файлов.
Скажем, имеется файл январь-2009.хls
после разбивки нужно что бы получилось январь-2009-1.xls
январь-2009-2.xls...................январь-2009-40.xls


СПАСИБО ЗА ОТВЕТЫ!!!!!!!!!!!!!!!
provodnikam вне форума   Ответить с цитированием
Старый 13.03.2010, 16:59   #2
Alex-roz
Пользователь
 
Регистрация: 12.03.2010
Адрес: Ростов-на-Дону
Сообщений: 15
Репутация: 16
По умолчанию

В excel 2007 это будет выглядеть примерно так:

Код:
Sub Макрос1()
'

Ch_Dir = "C:\temp\1\" 'Путь для сохранения файлов
x = 1
y = 500

For i = 1 To 40
    Range("A" & x & ":E" & y).Select
    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    
    file_name = "январь-2009-" & i & ".xlsx"
    
    ActiveWorkbook.SaveAs Filename:=Ch_Dir & file_name, FileFormat:=xlOpenXMLWorkbook _
        , CreateBackup:=False
    ActiveWindow.Close
    x = x + 500
    y = y + 500
    
Next i
End Sub

P.S. Не учитывается наличие данных в копируемых ячейках...

Последний раз редактировалось Arigato; 17.10.2018 в 15:03.
Alex-roz вне форума   Ответить с цитированием
Старый 13.03.2010, 17:03   #3
EducatedFool
Программист VBA
СуперМодератор
 
Аватар для EducatedFool
 
Регистрация: 13.07.2008
Адрес: Россия, Урал
Сообщений: 6,840
Репутация: 1286

skype: ExcelVBA.ru
По умолчанию

1. Где пример файла?
2. Строку заголовка (если такая есть) копировать в каждый файл?
3. Куда помещать созданные файлы? В ту же папку, где исходный файл, или в отдельную папку?
4. Что делать, если заполненных строк больше\меньше, чем 20000?
Изменять количество файлов, или изменять количество строк в них?
5. Зачем всё это нужно?

PS: Могу сделать быстро, но за небольшое вознаграждение. Если устроит - обращайтесь в личку.

Последний раз редактировалось EducatedFool; 13.03.2010 в 17:05.
EducatedFool на форуме   Ответить с цитированием
Старый 14.03.2010, 08:08   #4
provodnikam
Пользователь
 
Регистрация: 17.07.2009
Сообщений: 31
Репутация: 10
По умолчанию

Цитата:
Сообщение от Alex-roz Посмотреть сообщение
В excel 2007 это будет выглядеть примерно так:

Sub Макрос1()
'

Ch_Dir = "C:\temp\1\" 'Путь для сохранения файлов
x = 1
y = 500

For i = 1 To 40
Range("A" & x & ":E" & y).Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste

file_name = "январь-2009-" & i & ".xlsx"

ActiveWorkbook.SaveAs Filename:=Ch_Dir & file_name, FileFormat:=xlOpenXMLWorkbook _
, CreateBackup:=False
ActiveWindow.Close
x = x + 500
y = y + 500

Next i
End Sub


P.S. Не учитывается наличие данных в копируемых ячейках...






А в 2003-м как это всё сделать или в ХР
provodnikam вне форума   Ответить с цитированием
Старый 14.03.2010, 08:10   #5
provodnikam
Пользователь
 
Регистрация: 17.07.2009
Сообщений: 31
Репутация: 10
Лампочка

Цитата:
Сообщение от EducatedFool Посмотреть сообщение
1. Где пример файла?
2. Строку заголовка (если такая есть) копировать в каждый файл?
3. Куда помещать созданные файлы? В ту же папку, где исходный файл, или в отдельную папку?
4. Что делать, если заполненных строк больше\меньше, чем 20000?
Изменять количество файлов, или изменять количество строк в них?
5. Зачем всё это нужно?

PS: Могу сделать быстро, но за небольшое вознаграждение. Если устроит - обращайтесь в личку.
1. Файла прикреплю к ответу сейчас
2. Никаких строк заголовка нет. в файле, тупо данные
3. можно и в туже папку, откуда файл целиковый брали
4. больше быть не может. меньше - да
5. это всё нужно по работе)))))))))))))))
provodnikam вне форума   Ответить с цитированием
Старый 15.03.2010, 06:18   #6
SAS888
Профессионал
 
Аватар для SAS888
 
Регистрация: 05.12.2007
Сообщений: 4,162
Репутация: 1127
По умолчанию

Не зависимо от количества строк, можно так:
Код:
Sub DivFile()
    Dim i As Long, s As String, ws As Worksheet
    Application.ScreenUpdating = False: Set ws = ActiveSheet
    For i = 1 To ws.UsedRange.Row + ws.UsedRange.Rows.Count - 1 Step 500
        Workbooks.Add xlWBATWorksheet: ws.Rows(i & ":" & i + 499).Copy [A1]
        s = Replace(ThisWorkbook.FullName, ".xls", "-" & (Fix(i / 500) + 1) & ".xls")
        ActiveWorkbook.SaveAs s: ActiveWorkbook.Close
    Next
End Sub
__________________
Чем шире угол зрения, тем он тупее.
SAS888 вне форума   Ответить с цитированием
Старый 16.03.2010, 08:06   #7
provodnikam
Пользователь
 
Регистрация: 17.07.2009
Сообщений: 31
Репутация: 10
По умолчанию

Цитата:
Сообщение от SAS888 Посмотреть сообщение
Не зависимо от количества строк, можно так:
Код:
Sub DivFile()
    Dim i As Long, s As String, ws As Worksheet
    Application.ScreenUpdating = False: Set ws = ActiveSheet
    For i = 1 To ws.UsedRange.Row + ws.UsedRange.Rows.Count - 1 Step 500
        Workbooks.Add xlWBATWorksheet: ws.Rows(i & ":" & i + 499).Copy [A1]
        s = Replace(ThisWorkbook.FullName, ".xls", "-" & (Fix(i / 500) + 1) & ".xls")
        ActiveWorkbook.SaveAs s: ActiveWorkbook.Close
    Next
End Sub
СПАСИБО!!!!!
provodnikam вне форума   Ответить с цитированием
Старый 04.03.2012, 07:03   #8
Spens12
 
Регистрация: 04.03.2012
Сообщений: 5
Репутация: 10
По умолчанию

Цитата:
Сообщение от SAS888 Посмотреть сообщение
Не зависимо от количества строк, можно так:
Код:
Sub DivFile()
    Dim i As Long, s As String, ws As Worksheet
    Application.ScreenUpdating = False: Set ws = ActiveSheet
    For i = 1 To ws.UsedRange.Row + ws.UsedRange.Rows.Count - 1 Step 500
        Workbooks.Add xlWBATWorksheet: ws.Rows(i & ":" & i + 499).Copy [A1]
        s = Replace(ThisWorkbook.FullName, ".xls", "-" & (Fix(i / 500) + 1) & ".xls")
        ActiveWorkbook.SaveAs s: ActiveWorkbook.Close
    Next
End Sub
Спасибо, мне тоже пригодилось! Но хотелось бы при сохранение файлов, макрос однократно бы задал вопрос "Сохранить фаил как?" и можно было бы выбрать. Так-то мне нужен Юникод.txt, а txt там два???
Spens12 вне форума   Ответить с цитированием
Старый 05.03.2012, 09:36   #9
lilPrince
 
Регистрация: 05.03.2012
Сообщений: 6
Репутация: 10
По умолчанию

А как каждую строку в таблице сохранить в отдельный doc файл под номеров в столбце A, и еще если можно в такую же папку
Вложения
Тип файла: doc 1.doc (27.0 Кб, 19 просмотров)
lilPrince вне форума   Ответить с цитированием
Старый 05.03.2012, 11:26   #10
EducatedFool
Программист VBA
СуперМодератор
 
Аватар для EducatedFool
 
Регистрация: 13.07.2008
Адрес: Россия, Урал
Сообщений: 6,840
Репутация: 1286

skype: ExcelVBA.ru
По умолчанию

lilPrince, а какое отношение ваш вопрос имеет к теме раздела - Microsoft Excel?
EducatedFool на форуме   Ответить с цитированием
Ответ

Опции темы

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Программа разделения экрана на несколько частей ArtInt Софт 8 14.05.2012 10:29
Файл в несколько терабайт в архиве. Alex Cones Свободное общение 28 01.03.2010 18:08
Разбить Bitmap на несколько частей apromix Мультимедиа в Delphi 4 24.02.2010 12:26
Можно ли разделить сразу несколько цифр на одно и тоже число? Xell Microsoft Office Excel 2 12.01.2009 14:32
Как добавить в файл несколько строк?! zotox Помощь студентам 4 11.09.2008 22:32


13:28.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.