如何减少庞大的excel文件

Question

我在*.XLS中只有一个小而简单的文件,只有一张表,在这张表上只有许多单元格上有小文本的单元格.(文件大小24Kb)

但我做了很多改动,复制和粘贴,扩展公式,保存...之后我删除了大部分这些更改,并使用少量数据制作了4张重复的表格.

现在我的新文件非常庞大:2.5Mb!

隐藏数据在哪里？如何删除它？

我在真实文件上遇到同样的问题,每张300张和1张图片:文件大小280Mb

Answer 1

我以.XLSB格式保存文件以缩小尺寸.XLSB还允许VBA和宏保留在文件中.我已经看到使用二进制格式化的50兆文件低于10.

Answer 2

我写了一个VBA文件来添加一个工具来清理这些异常最大的文件.在最后一个单元格用于重置最后一个单元格([Ctrl] + [End])之后,此脚本清除所有列和行,并且还提供启用图像压缩.

我开发了一个带有自动安装的AddIns(只需在启用宏的情况下运行它),在上下文菜单中包含许多新按钮:

1. 优化
2. 优化和保存
3. 禁用优化工具

这是基于Microsoft Office 2003的KB和PP的答案.与个人改善:

1. 添加图像压缩
2. 修复列的错误
3. 与excel 2007 - 2010的专业兼容性......(超过255列)

解决方案 >您可以下载我的*.xlam文件ToolsKit

主要代码是

Sub ClearExcessRowsAndColumns()
    Dim ar As Range, r As Double, c As Double, tr As Double, tc As Double
    Dim wksWks As Worksheet, ur As Range, arCount As Integer, i As Integer
    Dim blProtCont As Boolean, blProtScen As Boolean, blProtDO As Boolean
    Dim shp As Shape
    Application.ScreenUpdating = False
    On Error Resume Next
    For Each wksWks In ActiveWorkbook.Worksheets
      Err.Clear
      'Store worksheet protection settings and unprotect if protected.
      blProtCont = wksWks.ProtectContents
      blProtDO = wksWks.ProtectDrawingObjects
      blProtScen = wksWks.ProtectScenarios
      wksWks.Unprotect ""
      If Err.Number = 1004 Then
         Err.Clear
         MsgBox "'" & wksWks.Name & "' is protected with a password and cannot be checked.", vbInformation
      Else
         Application.StatusBar = "Checking " & wksWks.Name & ", Please Wait..."
         r = 0
         c = 0

         'Determine if the sheet contains both formulas and constants
         Set ur = Union(wksWks.UsedRange.SpecialCells(xlCellTypeConstants), wksWks.UsedRange.SpecialCells(xlCellTypeFormulas))
         'If both fails, try constants only
         If Err.Number = 1004 Then
            Err.Clear
            Set ur = wksWks.UsedRange.SpecialCells(xlCellTypeConstants)
         End If
         'If constants fails then set it to formulas
         If Err.Number = 1004 Then
            Err.Clear
            Set ur = wksWks.UsedRange.SpecialCells(xlCellTypeFormulas)
         End If
         'If there is still an error then the worksheet is empty
         If Err.Number <> 0 Then
            Err.Clear
            If wksWks.UsedRange.Address <> "$A$1" Then
               ur.EntireRow.Delete
            Else
               Set ur = Nothing
            End If
         End If
         'On Error GoTo 0
         If Not ur Is Nothing Then
            arCount = ur.Areas.Count
            'determine the last column and row that contains data or formula
            For Each ar In ur.Areas
               i = i + 1
               tr = ar.Range("A1").Row + ar.Rows.Count - 1
               tc = ar.Range("A1").Column + ar.Columns.Count - 1
               If tc > c Then c = tc
               If tr > r Then r = tr
            Next
            'Determine the area covered by shapes
            'so we don't remove shading behind shapes
            For Each shp In wksWks.Shapes
               tr = shp.BottomRightCell.Row
               tc = shp.BottomRightCell.Column
               If tc > c Then c = tc
               If tr > r Then r = tr
            Next
            Application.StatusBar = "Clearing Excess Cells in " & wksWks.Name & ", Please Wait..."
            Set ur = wksWks.Rows(r + 1 & ":" & wksWks.Rows.Count)
                'Reset row height which can also cause the lastcell to be innacurate
                ur.EntireRow.RowHeight = wksWks.StandardHeight
                ur.Clear

            Set ur = wksWks.Columns(ColLetter(c + 1) & ":" & ColLetter(wksWks.Columns.Count))
                'Reset column width which can also cause the lastcell to be innacurate
                ur.EntireColumn.ColumnWidth = wksWks.StandardWidth
                ur.Clear
         End If
      End If
      'Reset protection.
      wksWks.Protect "", blProtDO, blProtCont, blProtScen
      Err.Clear
    Next
    Application.StatusBar = False
    ' prepare les combinaison de touches pour la validation automatique de la fenetre
    ' Application.SendKeys "%(oe)~{TAB}~"

    ' ouvre la fenetre de compression des images
    Application.CommandBars.ExecuteMso "PicturesCompress"
    Application.ScreenUpdating = True
End Sub


Function ColLetter(ColNumber As Integer) As String
    ColLetter = Left(Cells(1, ColNumber).Address(False, False), Len(Cells(1, ColNumber).Address(False, False)) - 1)
End Function