Joh*_*son 5 excel vba excel-vba
我正在尝试减少我正在使用的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.通过sheet + 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字节？
为了减少文件，我使用代码，但就您而言，根据您发布的内容，我认为它不会有帮助。我非常希望根据 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