如何减少一个巨大的excel文件

我有一个*.XLS格式的小而简单的文件，只有一张纸，在这张纸上只有许多单元格，数字上有小文本。（文件大小24Kb）

但我做了很多修改，复制粘贴，扩展公式，保存。。。之后，我删除了大部分更改，并用少量数据复制了4份此表

现在我的新文件非常大：2.5Mb

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

我在300张纸和每张纸上有一张图片的真实文件上也有同样的问题：文件大小280Mb看看像这样的帖子：或者

---

基本上：尝试谷歌搜索？

我将文件格式更改为*.XLSX此更改压缩我的文件并将文件大小减小15%

我将文件保存为.XLSB格式以减小大小。XLSB还允许VBA和宏保留在文件中。我见过50个meg文件，使用二进制格式，降到10个以下

我编写了一个VBA文件来添加一个工具来清理这些异常大的文件。 此脚本清除最后一个单元格后的所有列和行，该单元格实际上用于重置最后一个单元格（[Ctrl]+[End]），并且它还提供启用图像压缩

我开发了一个自动安装的加载项（只需在启用宏的情况下运行它），以便在上下文菜单中包含许多新按钮：

优化

优化并保存

禁用优化器

这是基于第页的答案和个人改进：

添加图像压缩

修复列的错误

feat与excel 2007-2010的兼容性。。。（超过255列）

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

主要代码是

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

子ClearExceSRowsAndColumns（）
变暗ar为量程，r为双精度，c为双精度，tr为双精度，tc为双精度
将wksWks作为工作表，ur作为范围，arCount作为整数，i作为整数
将blProtCont设置为布尔值，将blProtScen设置为布尔值，将blProtDO设置为布尔值
将shp变暗为形状
Application.ScreenUpdating=False
出错时继续下一步
对于ActiveWorkbook.工作表中的每项工作
呃，明白了
'存储工作表保护设置，如果受保护，则取消保护。
blProtCont=wksWks.ProtectContents
blProtDO=wksWks.ProtectDrawingObjects
blProtScen=wksWks.protect场景
wksWks.Unprotect“”
如果错误编号=1004，则
呃，明白了
MsgBox“'”和wksWks.Name&“受密码保护，无法检查。”，vbInformation
其他的
Application.StatusBar=“Checking”&wksWks.Name&”，请稍候
r=0
c=0
'确定工作表是否同时包含公式和常量
Set ur=Union（wksWks.UsedRange.SpecialCells（xlCellTypeConstants），wksWks.UsedRange.SpecialCells（xlCellTypeFormulas））
'如果两者都失败，请仅尝试常量
如果错误编号=1004，则
呃，明白了
设置ur=wksWks.UsedRange.SpecialCells（xlCellTypeConstants）
如果结束
'如果常量失败，则将其设置为公式
如果错误编号=1004，则
呃，明白了
Set ur=wksWks.UsedRange.SpecialCells（xlCellTypeFormulas）
如果结束
'如果仍有错误，则工作表为空
如果错误号为0，则
呃，明白了
如果wksWks.UsedRange.Address“$A$1”，则
ur.EntireRow.Delete
其他的
设置ur=无
如果结束
如果结束
'在出现错误时转到0
如果不是的话，你什么都不是
arCount=ur.Areas.Count
'确定包含数据或公式的最后一列和最后一行
对于ur.区域内的每个ar
i=i+1
tr=ar.Range（“A1”）.Row+ar.Rows.Count-1
tc=ar.Range（“A1”）.Column+ar.Columns.Count-1
如果tc>c，则c=tc
如果tr>r，则r=tr
下一个
'确定形状所覆盖的区域
“所以我们不删除形状后面的阴影
对于wksWks.形状中的每个shp
tr=shp.BottomRightCell.Row
tc=shp.BottomRightCell.Column
如果tc>c，则c=tc
如果tr>r，则r=tr
下一个
Application.StatusBar=“正在清除“&wksWks.Name&”中的多余单元格，请稍候…”
设置ur=wksWks.Rows（r+1&“：”&wksWks.Rows.Count）
'重置行高，这也可能导致最后一个单元格不准确
ur.EntireRow.RowHeight=wksWks.StandardHeight
明白了
设置ur=wksWks.Columns（ColLetter（c+1）&“&ColLetter（wksWks.Columns.Count））
'重置列宽，这也可能导致最后一个单元格不准确
ur.entireclumn.ColumnWidth=wksWks.StandardWidth
明白了
如果结束
如果结束
'重置保护。
wksWks.保护“”、保护区、保护区、保护区
呃，明白了
下一个
Application.StatusBar=False
“准备好fenetre自动验证系统
'Application.SendKeys“%（oe）~{TAB}”
“ouvre la fenetre de compression des images
Application.CommandBars.ExecuteMso“PicturesCompress”
Application.ScreenUpdating=True
端接头
函数ColLetter（ColNumber为整数）为字符串
ColLetter=Left（单元格（1，ColNumber）.地址（False，False），Len（单元格（1，ColNumber）.地址（False，False））-1）
端函数

如果您的文件只是文本，最好的解决方案是将每个工作表保存为.csv，然后重新导入excel-这需要更多的工作，但我将一个20MB的文件缩减为43KB。

我有一个24MB大小的excel文件，这要感谢其中的100多个图像。我通过以下步骤将大小减小到5MB以下：

选择每张图片，剪切（CTRL-X）并通过ALT E S位图选项以特殊模式粘贴

要查找哪个位图

ActiveSheet.UsedRange.Rows.Count
ActiveSheet.UsedRange.Columns.Count