Question

我正在尝试减少我正在使用的Excel工作簿的文件大小。我已经知道未使用的行是一个问题和不必要的图像等。神秘的是为什么excel的秘密部分似乎只是增长？

我可以用

发现整个文档的总大小

    Sub workbook_objectsize()
    With CreateObject("Scripting.FileSystemObject")
          Set wb = ActiveWorkbook
          WBObjectSize = .GetFile(wb.fullname).Size
          MsgBox (Format(WBObjectSize, "#,##0") & " Bytes")
    End With
    End Sub

我可以发现工作表的大小和使用

的WB对象

      Sub GetSheetSizes()
      ' ZVI:2012-05-18 Excel VBA File Size by Worksheet in File
      ' CAR:2014-10-07 Enhanced to take hidden and very hidden sheets into account

        Dim a() As Variant
        Dim Bytes As Double
        Dim i As Long
        Dim fileNameTmp As String
        Dim wb As Workbook
        Dim visState As Integer

        Set wb = ActiveWorkbook
        ReDim a(0 To wb.Sheets.Count, 1 To 2)

        ' Turn off screen updating
        Application.ScreenUpdating = False
        On Error GoTo exit_

        ' Put names into a(,1) and sizes into a(,2)
        With CreateObject("Scripting.FileSystemObject")
          ' Build the temporary file name
          Err.Clear
          fileNameTmp = .GetSpecialFolder(2) & "\" & wb.Name & ".TMP"
          ' Put workbook's name and size into a(0,)
          a(0, 1) = wb.Name
          a(0, 2) = .GetFile(wb.fullname).Size
          ' Put each sheet name and its size into a(i,)
          For i = 1 To wb.Sheets.Count
            visState = wb.Sheets(i).Visible
            wb.Sheets(i).Visible = -1 ' Show sheet long enough to copy it
            DoEvents
            wb.Sheets(i).Copy

            ActiveWorkbook.SaveCopyAs fileNameTmp

            wb.Sheets(i).Visible = visState
            a(i, 1) = wb.Sheets(i).Name
            a(i, 2) = .GetFile(fileNameTmp).Size
            Bytes = Bytes + a(i, 2)
            ActiveWorkbook.Close False
          Next
          Kill fileNameTmp
        End With

        ' Show workbook's name & size
        Debug.Print a(0, 1), Format(a(0, 2), "#,##0") & " Bytes"

        ' Show workbook object's  size
        Debug.Print "Wb Object", Format(a(0, 2) - Bytes, "#,##0") & " Bytes"

        ' Show each sheet name and its size
        For i = 1 To UBound(a)
          Debug.Print a(i, 1), Format(a(i, 2), "#,##0") & " Bytes"
        Next

      exit_:

        ' Restore screen updating
      Application.ScreenUpdating = True

    ' Show the reason of error if happened
       If Err Then MsgBox Err.Description, vbCritical, "Error"


    End Sub

这是练习。我有MYWORKBOOK

第1步。按工作表+ wb对象检查文件总大小和文件大小

      MYWORKBOOK Ver0.34 test.xlsm      932,450 Bytes Total
      Wb Object     201,679 Bytes
      Home          312,904 Bytes
      NISI_DETAIL   40,815 Bytes
      DATABASE      49,186 Bytes
      Settings      13,690 Bytes
      NISI_LIST     27,484 Bytes
      PleaseWait    21,232 Bytes
      success       22,077 Bytes
      Brands        34,721 Bytes
      USER_LIST     26,819 Bytes
      QUERY_LIST    37,880 Bytes
      CAT_MAN_TOOLS 88,406 Bytes
      Sheet1        9,997 Bytes
      PROMO_LIST    45,560 Bytes

第2步。删除所有表格，只留下一张新的空白纸张并再次检查

      MYWORKBOOK Ver0.34 test .xlsm     370,052 Bytes
      Wb Object     361,589 Bytes
      Sheet1        8,463 Bytes

是文件大小减少了但那是因为我删除了每张纸。但是，这个神秘的Wb对象实际上变大了。我勒个去？？？只有一张空白纸和370Kb文件????? BTW在新工作簿上运行相同的测试，其Wb对象大小为0字节。

TL; DR：上面示例中的Wb对象究竟是什么？它为什么一直在增长？如何将其减少到0字节？

Answer 1

对于文件缩减我使用代码，但在您的情况下，我看不出它会根据您发布的内容提供帮助。我非常希望根据GSergs的建议看到zip文件的内容。

这是我的文件缩减代码，如果你想尝试但是就像我说的那样，我没有看到它会像你希望的那样小，但它值得一试：

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

Answer 2

我发现一些excel工作簿中导入的数据过多，导致工作表中的列数超过16k，行数超过65k-无法操作-找到了删除列和行的方法-技巧是从头开始，向后工作一路保存。文件大小从3mb减少到125k。下面的代码-读取，测试和使用需要您自担风险...

Function delsht()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.CutCopyMode = False

Sheet3.AutoFilterMode = False
DoEvents
Debug.Print Sheet3.UsedRange.Address
  '  c = psht.UsedRange.Columns(psht.UsedRange.Columns.Count).Column
  '  For i = c To 1500 Step -500
  '          psht.Range(Columns(i), Columns(i - 500)).Delete
  '          DoEvents
  '          ActiveWorkbook.Save
  '          Debug.Print i, Time()
  '  Next i
r = Sheet3.UsedRange.Rows(Sheet3.UsedRange.Rows.Count).Row
For i = r To 2000 Step -500
        Sheet3.Range(Rows(i), Rows(i - 500)).Delete
        DoEvents
        ActiveWorkbook.Save
        Debug.Print i, Time()
Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Debug.Print "done."
End Function
Function bloatfinder()
Dim sht As Worksheet
For Each sht In Application.ActiveWorkbook.Sheets
Debug.Print sht.Name, sht.UsedRange.Address,
c = sht.UsedRange.Columns(sht.UsedRange.Columns.Count).Column
r = sht.UsedRange.Rows(sht.UsedRange.Rows.Count).Row
Debug.Print "  Rows:", r, "Cols:", c
Next
Set sht = Nothing
End Function

什么进入Excel工作簿对象，增加文件大小？

2 个答案: