Как разделить .xlsx по строкам?

Question

[Alex]

Есть большой файл больше 27 000 строк. Как его разделить на такие же .xlsx файлы, но скажем по 1000 строк?

Answer 1

[h8nor]

Если файл сохранён на диске, можно так:
1. Открываете книгу с данными на нужном листе
2. Заходите в VBA (Alt+F11)
3. Выбираете в меню Insert -> Module
4. Вставляете нижеприведённый код
5. Нажимаете F5 (не сохраняете исходный файл)

Option Explicit ' Обязательное объявление переменных
Option Base 1 ' Нижняя граница массива (по умолчанию)
'123456789012345678901234567890123456h8nor@ya567890123456789012345678toster56789

Sub Border_Limit()
  Dim Limit As Integer, Count As Integer, SaveDir As String, SetTitle As Boolean
  
  Count = 1: Limit = 1000 ' Счётчик файлов; Количество строк
  SetTitle = False ' Если есть заголовок, заменить False на True
  
  SaveDir = ThisWorkbook.Path ' Или вписать полный путь для сохранения "C:\"
  ' Предполагается, что в колонке A нет пустых ячеек
  While Not IsEmpty(Cells(IIf(SetTitle, 2, 1), 1))
    Rows("1:" & Limit).Copy
    Workbooks.Add xlWBATWorksheet ' Создать новую книгу: шаблон с 1 листом
    ActiveSheet.Paste: Cells(1, 1).Select
    ActiveWorkbook.SaveAs Filename:=SaveDir & "\Массив_" & Count & ".xlsx", _
      FileFormat:=xlOpenXMLWorkbook
    ActiveWindow.Close
    Rows(IIf(SetTitle, 2, 1) & ":" & Limit).Delete Shift:=xlUp
    Count = Count + 1
  Wend: MsgBox "Файл разбит на " & Count - 1 & " файл(ов). "
End Sub

Никакие C++ запускать не надо.

Для пытливых умов: Отказ от Слияния в пользу шаблонов https://toster.ru/q/320942

Comments

[kolyayolo]

Как сохранить ширину строк исходной таблицы? Также как сохранить заголовок во всех файлах? При выборе "2" заголовок не сохраняется.
Заранее спасибо

[h8nor]

kolyayolo, благодарю за замечание (обновил код), и хороший вопрос.
Для переноса ширины колонок нужно после объявления переменных сохранить значения ширины колонок в массив:

ReDim colWidth(Cells.SpecialCells(xlLastCell).Column)
  For Count = 1 To UBound(colWidth) ' Читаем ширину колонок
    colWidth(Count) = Cells(1, Count).ColumnWidth
  Next Count

Затем, после вставки данных перенести значения ширины колонок из массива:

' Пишем ширину колонок
    Cells(1, 1).Resize(1, UBound(colWidth)).ColumnWidth = colWidth

[alcompstudio]

Добрый день!

Спасибо за решение, искал везде, ваш подошел идеально! Единственный вопрос - а как сделать, чтобы полученные таблицы-файлы были "упакованы" в умные таблицы на выходе? Я не силен в VBA, подскажете какой код и куда его вписать?

[alcompstudio]

Добавил код, который добавляет умную таблицу к диапазону, но есть проблема. У меня файлы формируются из заранее подготовленной умной таблицы, т.е. она разбивается на части. И этот (ваш) код получается формирует файлы с не отформатированными диапазонами, а последний файл именно форматируется в умную таблицу (как бы унаследует формат из исходного файла). Т.е. не все сформированные файлы с умными таблицами получаются, а только последний. А мне нужно, чтобы все были оформлены в умные таблицы. Я добавил код, который добавляет формат в полученные файлы, вот такое у меня получилось:

Option Explicit ' Обязательное объявление переменных
Option Base 1 ' Нижняя граница массива (по умолчанию)
'12345678901234567890123456789012345bopoh13@ya67890123456789012345678toster56789

Sub Border_Limit()
  Dim Limit As Integer, Count As Integer, SaveDir As String, SetTitle As Boolean

  Count = 1: Limit = 2001 ' Счётчик файлов; Количество строк
  SetTitle = True ' Если есть заголовок, заменить False на True
      
  SaveDir = "F:\ZeusCeramica\Веб-система\Руководитель\Спецификации" ' Или вписать полный путь для сохранения "F:\ZeusCeramica\Веб-система\Руководитель\Спецификации" или ThisWorkbook.Path
  ' Предполагается, что в колонке A нет пустых ячеек
  While Not IsEmpty(Cells(IIf(SetTitle, 2, 1), 1))
    Rows("1:" & Limit).Copy
    Workbooks.Add xlWBATWorksheet ' Создать новую книгу: шаблон с 1 листом
    ActiveSheet.Paste: Cells(1, 1).Select
    
    '-------Оформляем полученные таблицы в умные----------
    
    Dim a As Long
    'Определяем количество строк
        a = Cells(1, 1).CurrentRegion.Rows.Count
        'Создаем «умную» таблицу с сохранением первой строки заголовков
        ActiveSheet.ListObjects.Add(xlSrcRange, Range(Cells(1, 1), Cells(a, 17)), , xlYes).Name _
        = "TableRange"

    ActiveWorkbook.SaveAs Filename:=SaveDir & "\BOM_test_" & Count & ".xlsx", _
      FileFormat:=xlOpenXMLWorkbook
    ActiveWindow.Close
    Rows(IIf(SetTitle, 2, 1) & ":" & Limit).Delete Shift:=xlUp
    Count = Count + 1
   Wend: MsgBox "Файл разбит на " & Count - 1 & " файл(ов). "
End Sub

Но в результате получается ошибка, т.к. система пытается последнюю таблицу, которая "умная" тоже повторно оформить.
Подскажете, как подправить?

[h8nor]

kolyayolo, alcompstudio, на технических ресурсах принято выражать свою положительную оценку кнопкой "Нравится", тем самым указывая на полезность материала.

Для создания умной таблицы для всего активного листа с именем "Table_1" используется следующий метод (четвёртый параметр указывает на наличие заголовков):

ActiveSheet.ListObjects.Add(, ActiveSheet.UsedRange, , xlYes).Name = "Table_1"

Для удаления единственной умной таблицы на активном листе используется метод:
ActiveSheet.ListObjects(1).Delete

Answer 2

[Евгений]

Написать скрипт на VBA, правда не знаю умеет ли он сохранять в отдельный файл, но почти уверен, что умеет. Либо написать небольшое приложение например на C++, которое через COM откроет исходный файл и попилит его на мелкие.

Answer 3

[Дмитрий]

вторая ссылка в google programmersforum.ru/showthread.php?t=88004