Вход | Регистрация
 
Информационные технологии :: Администрирование

Файл Excel 1 гигабайт

Файл Excel 1 гигабайт
Я
   DJ Anthon
 
07.10.20 - 03:41
Упоротые клуши наделали кучу страниц размером 1000000х1000 ячеек. То, что файл открывался по часу, их не смущало.
В интернете нет способов очистить неиспользуемые ячейки, там алгоритмы по удалению пустых ячеек внутри таблиц. В бинарную книгу файл не сохраняется, но пока ещё живой.
Копировать постранично информацию не получается, размеры столбцов и строк теряются. Если удаляю строки или ячейки со сдвигом - все равно, последняя ячейка остается с адресом 1000000х1000, а страниц много.
Есть ли какой-нибудь способ этот файл уменьшить?
   DJ Anthon
 
1 - 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
   v77
 
2 - 07.10.20 - 07:52
скопировать, что надо, в новую книгу
   arsik
 
3 - 07.10.20 - 08:43
(2) Ну так он же пишет, что форматирование строк колонок пропадает.
1000000х1000 - что строки, что колонки?
Удалить строки по алгоритму, если в строке пустое значение повторяется n раз, значит дальше точно пусто. Ну и колонки так же.
   Кирпич
 
4 - 07.10.20 - 08:48
(3) Да он вроде про форматирование не писал. Да и нафиг там форматирование. Эти таблицы люди не смотрят. Их же даже открыть невозможно :)
   Kigo_Kigo
 
5 - 07.10.20 - 09:12
ну если отрывается по часу, то можно открыть, как вариант, пересохранить в CSV , восстоновить из CSV,  ну это если не хитрожопый без формул и макросов файл
   Defender77
 
6 - 07.10.20 - 10:11
Открыть файл любым архиватором. в папке xl\worksheets находятся все листы. Удалять по размеру/вкусу. Ссылки могут потеряться
   Волшебник
 
7 - 07.10.20 - 10:13
Переименовать в zip, распаковать, удалить лишнее, запаковать и переименовать обратно в xlsx
   Kigo_Kigo
 
8 - 07.10.20 - 10:46
(7) Жаль что собрать это все гемморно обратно, есть у меня файлик екселя, где куча ненужных картинок,сча попробывал, прибил картинки, файл ессно не собрался обратно
   Волшебник
 
9 - 07.10.20 - 10:47
(8) Надо было не прибить, а подменить
   sitex
 
10 - 07.10.20 - 10:51
(8) а попробуй картинку заменить на пустую с таким же названием хотя бы одну.
   Kigo_Kigo
 
11 - 07.10.20 - 10:58
(10) Да даже если заменить, я так прикинул там примерно 200 штук их надо заменить, все под разными именами, их жаль что нельзя как в 1с удалить битые ссылки )))
ПыСы проблему то уже решили, просто для саморазвития
   Kigo_Kigo
 
12 - 07.10.20 - 11:00
в смысле, что бы ексель при открытии сказал - восстановить? (он это собственно и спрашивает), но не восстанавливает файл, и сам бы убрал из структуры битые ссылки на картинки

Список тем форума
Рекламное место пустует  Рекламное место пустует
Кaк может человек ожидaть, что его мольбaм о снисхождении ответит тот, кто превыше, когдa сaм он откaзывaет в милосердии тем, кто ниже его? Петр Трубецкой
ВНИМАНИЕ! Если вы потеряли окно ввода сообщения, нажмите Ctrl-F5 или Ctrl-R или кнопку "Обновить" в браузере.