删除excel选项卡不会减小文件大小

Question

为了减少60MB excel文件，我删除了一半选项卡以及其余选项卡上的许多公式。 结果并未预测整个文件大小。也许（如在访问中）有一个函数/插件/？这将压缩或恢复空间？ 我试图将标签导出到一个新文件，但是，大多数标签都有表格，所以不可能。

顺便说一句，该文件已经在.XLSB格式。 谢谢你， -R

Answer 1

这里是我的吸脂代码，我几年前写的，它会做的公式，文本和图片，没有做图表目前，但你可以看到它是如何处理的图片和补充说，很轻松地。

Sub LipoSuction2() 
'Written by Daniel Donoghue 18/8/2009 
'The purpose of this code is to offer an alternative to the original Liposuction code written by JBeaucaire for the MrExcel forums www.mrexcel.com 
Dim ws As Worksheet 
Dim CurrentSheet As String 
Dim OldSheet As String 
Dim Col As Long 
Dim r As Long 
Dim BottomrRow As Long 
Dim EndCol As Long 
'Begin addition 6/4/2010 for request: http://www.mrexcel.com/forum/showthread.php?p=2269274#post2269274 
Dim Pic As Object 
'End Addition 6/4/2010 for request: http://www.mrexcel.com/forum/showthread.php?p=2269274#post2269274 
For Each ws In Worksheets 
    ws.Activate 
    'Put the sheets in a variable to make it easy to go back and forth 
    CurrentSheet = ws.Name 
    'Rename the sheet to its name with TRMFAT at the end 
    OldSheet = CurrentSheet & "TRMFAT" 
    ws.Name = OldSheet 
    'Add a new sheet and call it the original sheets name 
    Sheets.Add 
    ActiveSheet.Name = CurrentSheet 
    Sheets(OldSheet).Activate 
    'Find the bottom cell of data on each column and find the further row 
    For Col = 1 To Columns.Count 'Find the REAL bottom row 
     If Cells(Rows.Count, Col).End(xlUp).Row > BottomRow Then 
      BottomRow = Cells(Rows.Count, Col).End(xlUp).Row 
     End If 
    Next 
    'Find the end cell of data on each row that has data and find the furthest one 
    For r = 1 To BottomRow 'Find the REAL most right column 
     If Cells(r, Columns.Count).End(xlToLeft).Column > EndCol Then 
      EndCol = Cells(r, Columns.Count).End(xlToLeft).Column 
     End If 
    Next 
    'Copy the REAL set of data 
    Range(Cells(1, 1), Cells(BottomRow, EndCol)).Copy 
    Sheets(CurrentSheet).Activate 
    'Paste everything 
    Range("A1").PasteSpecial xlPasteAll 
    'Paste Column Widths 
    Range("A1").PasteSpecial xlPasteColumnWidths 
    'Begin addition 6/4/2010 for request: http://www.mrexcel.com/forum/showthread.php?p=2269274#post2269274 
    Sheets(OldSheet).Activate 
    For Each Pic In ActiveSheet.Pictures 
     Pic.Copy 
     Sheets(CurrentSheet).Paste 
     Sheets(CurrentSheet).Pictures(Pic.Index).Top = Pic.Top 
     Sheets(CurrentSheet).Pictures(Pic.Index).Left = Pic.Left 
    Next 
    Sheets(CurrentSheet).Activate 
    'End Addition 6/4/2010 for request: http://www.mrexcel.com/forum/showthread.php?p=2269274#post2269274 
    'Reset the variable for the next sheet 
    BottomRow = 0 
    EndCol = 0 
Next 
'Excel will automatically replace the sheet references for you on your formulas, the below part puts them back 
'This is done with a simple reaplce, replacing TRMFAT with nothing 
For Each ws In Worksheets 
    ws.Activate 
    Cells.Replace "TRMFAT", "" 
Next 
'Poll through the sheets and delete the original bloated sheets 
For Each ws In Worksheets 
    If Not Len(Replace(ws.Name, "TRMFAT", "")) = Len(ws.Name) Then 
     Application.DisplayAlerts = False 
     ws.Delete 
     Application.DisplayAlerts = True 
    End If 
Next 
End Sub