Страницы: 1
RSS
Разделение таблицы Excel на несколько файлов, Разделение таблицы Excel на несколько файлов в зависимости от числа строк или размера файла
 
Доброго времени суток уважаемые форумчане!

Имею книгу Excel с одним листом, с одной таблицей на 18 столбцов. Первая строка - строка заголовков.
Стоит задача по разделению файла на несколько (либо на файлы размером не более 8Мб, либо если первый вариант не возможен, на файлы не более 90 000 строк ).
С сохранением перовой строки заголовков в каждом файле.
С присвоением каждому файлу имя_исходное_1 (_2 и т.д.)

Заранее спасибо!  
 
ashchin, гугЕл в помощь
https://www.cyberforum.ru/ms-excel/thread1161039.html
https://excelvba.ru/code/SplitTextFile
https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=8&TID=25707
https://qna.habr.com/q/125607
Не бойтесь совершенства. Вам его не достичь.
 
Цитата
Mershik написал:
ashchin , гугЕл в помощь
Здравствуйте! Спасибо за ссылки. Перед тем как задать вопрос, я ответственно гуглил, но не найдя ответа решил обратиться на данный форум с вопросом.
Изменено: nikita-pnz - 30.11.2020 15:55:09 (Многосложный ответ)
 
Ниже представленный код как я понимаю, именно то что мне нужно. Но к большому сожалению, при исполнения макроса возникает 2 проблемы, а именно:

1. Файлы после разделения файла имеют расширение .bin, например имя_файла.xlsx_001.bin
2. После изменения расширения файла, путем его переименования, и последующей открытии в Excel: "Не удается открыть файл "имя файла", так как формат или содержание этого файла является недопустимым. Убедитесь, что файл не поврежден и расширение имени соответствует его формату".

Буду признателен за помощь с кодом макроса!

Код
Sub Scorpion86rus()
Dim bytesLeft&, partSize&, b() As Byte, fileName, f%, g%, cnt&, baseName$
fileName = Application.GetOpenFilename("All files,*.*", , "Выберите файл для деления")
If fileName = False Then Exit Sub
  'из полного пути выделяем имя файла с "\"
baseName = Right$(fileName, Len(fileName) - InStrRev(fileName, "\") + 1)
With Application.FileDialog(msoFileDialogFolderPicker)
  .Title = "Выберите папку для сохранения"
  .Show
  If .SelectedItems.Count = 0 Then Exit Sub
    'формируем основу пути файла для сохранения из выбранной папки и имени файла для деления
  baseName = .SelectedItems(1) & baseName
End With
partSize = InputBox("Введите размер части (байт)", , 5000)
f = FreeFile
Open fileName For Binary Access Read As f
bytesLeft = LOF(f)     'размер файла в байта, столько байт осталось записать
ReDim b(1 To partSize) 'буфер длиной с размер части
Do
    'если длина буфера больше, чем осталось записать байт,
    'делаем буфер длиной сколько байт осталось, это будет последний файл
  If UBound(b) > bytesLeft Then ReDim b(1 To bytesLeft)
    'уменьшаем число оставшихся байт на размер буфера
  bytesLeft = bytesLeft - UBound(b)
    'считываем очередной кусок файла в буфер
  Get f, , b
  g = FreeFile
    'увеличиваем счетчик файлов на 1
  cnt = cnt + 1
    'записываем очередной файл
  Open baseName & Format(cnt, "_000\.bin") For Binary Access Write As g
  Put g, , b
  Close g
    'продолжаем цикл, пока осталось записать байт >0
Loop While bytesLeft
Close f
MsgBox "Записано " & cnt & " файлов", vbInformation
End Sub
Изменено: nikita-pnz - 30.11.2020 15:50:54
 
Этим можно архивы на части делить, только затем нужно вспомнить как их затем назад собирать...
Ну когда на дискету не лезет :)
P.S. Нашёл!
Объединить части обратно можно консольной командой
Код
copy /b file1+file2+file3 newfile
Изменено: Hugo - 30.11.2020 16:03:28
 
Mershik, Казанский всюду поспевал :)
Что-то давно не видать, никто не в курсе, может что случилось?
 
Hugo, та да, ну судя что Последний визит: 5 июн 2019 06:55:13 он покинул нас как пол года)
Не бойтесь совершенства. Вам его не достичь.
 
Не пол, а почти полтора :)
Последнее что я нашёл - боялся в саду тупой кровохлебки :)
27 марта 2020 15:32
Страницы: 1
Наверх