|
Файл Excel 1 гигабайт | ☑ | ||
---|---|---|---|---|
0
DJ Anthon
07.10.20
✎
03:41
|
Упоротые клуши наделали кучу страниц размером 1000000х1000 ячеек. То, что файл открывался по часу, их не смущало.
В интернете нет способов очистить неиспользуемые ячейки, там алгоритмы по удалению пустых ячеек внутри таблиц. В бинарную книгу файл не сохраняется, но пока ещё живой. Копировать постранично информацию не получается, размеры столбцов и строк теряются. Если удаляю строки или ячейки со сдвигом - все равно, последняя ячейка остается с адресом 1000000х1000, а страниц много. Есть ли какой-нибудь способ этот файл уменьшить? |
|||
1
DJ Anthon
07.10.20
✎
03:56
|
Так, все-таки через восстановление длины столбцов и строк придётся делать, нашёл рабочий макрос, правда, он валится с ошибкой, но вроде бы делает то, что нужно.
Option Explicit Option Base 1 Sub ReduceSize() ' фитнесс для разбухших файлов '--------------------------------------------------------------------------------------- ' Procedure : ReduceSize ' Author : KuklP + Alex_ST ("полировка" и комментарии) ' URL : http://www.excelworld.ru/forum/3-57-1 ' Date : 10.09.2010 + 01.02.2011 ' Purpose : фитнесс для разбухших файлов '--------------------------------------------------------------------------------------- Dim LastRow&, LastColumn% Dim arrRowsHeight!(), arrColumnsWidth!() Dim oldWbName$, newWbName$ Dim WbPath$, iShtName$ Dim iSht As Worksheet Dim newWb As Workbook Dim i%, n% WbPath = ActiveWorkbook.Path ' запомним путь к книге oldWbName = ActiveWorkbook.Name ' запомним имя старой книги Set newWb = Workbooks.Add ' создадим новую книгу (она сразу станет ActiveWorkbook) ActiveWorkbook.SaveAs WbPath & "\" & "(NEW) " & oldWbName 'сохраним новую книгу рядом со старой с префиксом к имени "(NEW) " newWbName = ActiveWorkbook.Name ' запомним имя новой книги i = 1 ' начинаем с первой страницы новой книги For Each iSht In ThisWorkbook.Sheets ' цикл по всем листам старой(ThisWorkbook) книги iSht.Activate iShtName = ActiveSheet.Name LastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row ' последняя строка на листе, содержащая хоть какие-нибудь значения LastColumn = Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column ' последний столбец на листе, содержащий хоть какие-нибудь значения ReDim arrRowsHeight(LastRow) ReDim arrColumnsWidth(LastColumn) For n = 1 To LastRow ' запомним высоты строк в массив arrRowsHeight(n) = Rows(n).RowHeight Next n For n = 1 To LastColumn ' запомним ширины столбцов в массив arrColumnsWidth(n) = Columns(n).ColumnWidth Next n Application.CutCopyMode = False Range(Cells(1, 1), Cells(LastRow, LastColumn)).Copy ' копируем только диапазон, содержащий данные With newWb If .Sheets.Count < i Then .Sheets.Add after:=.Sheets(.Sheets.Count) .Sheets(i).Name = iShtName .Sheets(i).Paste ' копируем на страницы новой книги диапазон, содержащий данные Application.CutCopyMode = False For n = 1 To LastRow ' восстановим высоты строк .Sheets(i).Rows(n).RowHeight = arrRowsHeight(n) Next n For n = 1 To LastColumn ' восстановим ширины столбцов .Sheets(i).Columns(n).ColumnWidth = arrColumnsWidth(n) Next n End With i = i + 1 ' продолжим на следующей странице новой книги Next Application.DisplayAlerts = False Call ExportAllStdModules(Workbooks(newWbName)) ' скопировать все компоненты VBA в новую книгу Workbooks(newWbName).Save ' сохраним новую книгу Workbooks(oldWbName).Close SaveChanges:=False ' закроем старую книгу без сохранения изменений Application.DisplayAlerts = True End Sub Private Sub ExportAllStdModules(wb As Workbook) ' скопировать все компоненты VBA в новую книгу Dim iTempPath$, iModuleName$ Dim iVBComponent With Application .ScreenUpdating = False iTempPath = .DefaultFilePath & .PathSeparator With wb.VBProject.VBComponents For Each iVBComponent In ThisWorkbook.VBProject.VBComponents If iVBComponent.Type = 1 Then iModuleName$ = iTempPath$ & iVBComponent.Name iVBComponent.Export Filename:=iModuleName$ .Import Filename:=iModuleName$ Kill PathName:=iModuleName$ End If Next End With .ScreenUpdating = True End With End Sub |
|||
2
v77
07.10.20
✎
07:52
|
скопировать, что надо, в новую книгу
|
|||
3
arsik
гуру
07.10.20
✎
08:43
|
(2) Ну так он же пишет, что форматирование строк колонок пропадает.
1000000х1000 - что строки, что колонки? Удалить строки по алгоритму, если в строке пустое значение повторяется n раз, значит дальше точно пусто. Ну и колонки так же. |
|||
4
Кирпич
07.10.20
✎
08:48
|
(3) Да он вроде про форматирование не писал. Да и нафиг там форматирование. Эти таблицы люди не смотрят. Их же даже открыть невозможно :)
|
|||
5
Kigo_Kigo
07.10.20
✎
09:12
|
ну если отрывается по часу, то можно открыть, как вариант, пересохранить в CSV , восстоновить из CSV, ну это если не хитрожопый без формул и макросов файл
|
|||
6
Defender77
07.10.20
✎
10:11
|
Открыть файл любым архиватором. в папке xl\worksheets находятся все листы. Удалять по размеру/вкусу. Ссылки могут потеряться
|
|||
7
Волшебник
07.10.20
✎
10:13
|
Переименовать в zip, распаковать, удалить лишнее, запаковать и переименовать обратно в xlsx
|
|||
8
Kigo_Kigo
07.10.20
✎
10:46
|
(7) Жаль что собрать это все гемморно обратно, есть у меня файлик екселя, где куча ненужных картинок,сча попробывал, прибил картинки, файл ессно не собрался обратно
|
|||
9
Волшебник
07.10.20
✎
10:47
|
(8) Надо было не прибить, а подменить
|
|||
10
sitex
naïve
07.10.20
✎
10:51
|
(8) а попробуй картинку заменить на пустую с таким же названием хотя бы одну.
|
|||
11
Kigo_Kigo
07.10.20
✎
10:58
|
(10) Да даже если заменить, я так прикинул там примерно 200 штук их надо заменить, все под разными именами, их жаль что нельзя как в 1с удалить битые ссылки )))
ПыСы проблему то уже решили, просто для саморазвития |
|||
12
Kigo_Kigo
07.10.20
✎
11:00
|
в смысле, что бы ексель при открытии сказал - восстановить? (он это собственно и спрашивает), но не восстанавливает файл, и сам бы убрал из структуры битые ссылки на картинки
|
Форум | Правила | Описание | Объявления | Секции | Поиск | Книга знаний | Вики-миста |