Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/разбивка файла на несколько файлов с учетом имени ячейки - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » разбивка файла на несколько файлов с учетом имени ячейки (Макросы/Sub)
разбивка файла на несколько файлов с учетом имени ячейки
exceler Дата: Четверг, 04.05.2017, 11:48 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Добрый день! нашла на этом форуме замечательной код с разбивкой по фиксированному количеству строк. Мне необходимо было подкорректировать его, чтобы он не делил без шапки со словом HDR т.е. каждый новый файл должен был начинаться со слова HDR. Но данный код делает только 4 файла, а дальше не работает. Всего строк 10000, необходимо разбить на строки 600-700.

[vba]
Код
Sub razbivka()
Dim ROWS_IN_PART As Integer
ROWS_IN_PART = 600
Dim i&, j&, q&, ws As Worksheet, nm$
i = 1
Set ws = ActiveSheet
nm = Left(ActiveWorkbook.FullName, _
InStrRev(ActiveWorkbook.FullName, ".") - 1) & "_"
Application.ScreenUpdating = False
For q = 1 To ActiveSheet.UsedRange.Rows.Count Step 600
If Cells(i + ROWS_IN_PART, 1).Value = "HDR" Then
With Workbooks.Add(xlWBATWorksheet)
Range(ws.Rows(i), ws.Rows(i + ROWS_IN_PART - 1)).Copy ActiveCell
j = j + 1
.Close True, nm & Format(j, "000")
i = i + ROWS_IN_PART
End With
Else
ROWS_IN_PART = ROWS_IN_PART + 1
End If
Next
Application.ScreenUpdating = True
End Sub
[/vba]


Сообщение отредактировал exceler - Четверг, 04.05.2017, 12:25
 
Ответить
СообщениеДобрый день! нашла на этом форуме замечательной код с разбивкой по фиксированному количеству строк. Мне необходимо было подкорректировать его, чтобы он не делил без шапки со словом HDR т.е. каждый новый файл должен был начинаться со слова HDR. Но данный код делает только 4 файла, а дальше не работает. Всего строк 10000, необходимо разбить на строки 600-700.

[vba]
Код
Sub razbivka()
Dim ROWS_IN_PART As Integer
ROWS_IN_PART = 600
Dim i&, j&, q&, ws As Worksheet, nm$
i = 1
Set ws = ActiveSheet
nm = Left(ActiveWorkbook.FullName, _
InStrRev(ActiveWorkbook.FullName, ".") - 1) & "_"
Application.ScreenUpdating = False
For q = 1 To ActiveSheet.UsedRange.Rows.Count Step 600
If Cells(i + ROWS_IN_PART, 1).Value = "HDR" Then
With Workbooks.Add(xlWBATWorksheet)
Range(ws.Rows(i), ws.Rows(i + ROWS_IN_PART - 1)).Copy ActiveCell
j = j + 1
.Close True, nm & Format(j, "000")
i = i + ROWS_IN_PART
End With
Else
ROWS_IN_PART = ROWS_IN_PART + 1
End If
Next
Application.ScreenUpdating = True
End Sub
[/vba]

Автор - exceler
Дата добавления - 04.05.2017 в 11:48
китин Дата: Четверг, 04.05.2017, 11:51 | Сообщение № 2
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4280
Репутация: 665 ±
Замечаний: 0% ±

Excel 2007;Excel 2010


Не судите строго:я пытаюсь научиться
ЯД 41001877306852/WM R249698041931; Z239672726538
 
Ответить
Сообщение Как оформлять сообщения?

Автор - китин
Дата добавления - 04.05.2017 в 11:51
exceler Дата: Четверг, 04.05.2017, 14:59 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Вопрос закрыт!
 
Ответить
СообщениеВопрос закрыт!

Автор - exceler
Дата добавления - 04.05.2017 в 14:59
Мир MS Excel » Вопросы и решения » Вопросы по VBA » разбивка файла на несколько файлов с учетом имени ячейки (Макросы/Sub)
Страница 1 из 11
Поиск:

Яндекс цитирования
© 2010-2017 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!