Warning: file_get_contents(/data/phpspider/zhask/data//catemap/0/vba/17.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181

Warning: file_get_contents(/data/phpspider/zhask/data//catemap/5/excel/28.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Vba Excel工作簿对象中的哪些内容会增加文件大小?_Vba_Excel - Fatal编程技术网

Vba Excel工作簿对象中的哪些内容会增加文件大小?

Vba Excel工作簿对象中的哪些内容会增加文件大小?,vba,excel,Vba,Excel,我正在尝试减小正在使用的Excel工作簿的文件大小。我已经知道未使用的行是一个问题,不必要的图像等。神秘的是为什么有一个秘密部分的excel,似乎只有增长 我可以使用 Sub workbook_objectsize() With CreateObject("Scripting.FileSystemObject") Set wb = ActiveWorkbook WBObjectSize = .GetFile(wb.fullname).Siz

我正在尝试减小正在使用的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
这是练习。我有我的工作簿

步骤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。删除所有工作表,只留下新的空白工作表1,然后再次检查

      MYWORKBOOK Ver0.34 test .xlsm     370,052 Bytes
      Wb Object     361,589 Bytes
      Sheet1        8,463 Bytes
是的,文件大小减小了,但那是因为我删除了每张纸。然而,这个神秘的Wb物体实际上变大了。我勒个去???只有一张空白纸和一个370Kb的文件????? 顺便说一句,在新工作簿上运行相同的测试会导致Wb对象大小为0字节


TL;DR:上面例子中的Wb对象到底是什么?为什么它一直在增长?如何将其缩减为0字节?

对于文件缩减,我使用代码,但对于您的情况,根据您发布的内容,我看不出它会有帮助。我会非常渴望看到的内容的zip文件每GSergs的建议

这是我的文件缩减代码,如果您想尝试,但正如我所说,我不认为它会像您希望的那样小,但值得一试:

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

我发现一些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

伟大的问题,有趣的研究来支持它!不幸的是,我感觉它将作为OT关闭(什么是OT?我希望它没有关闭,我真的需要一个答案。我已经在网络上找遍了。
xlsm
是一个zip存档。重命名为
test.zip
,用存档浏览器打开,看看是什么占据了空间。@FreeMan关于这个主题的文章也是“OT”)@Mat'sMug OP是,但大多数人认为它是原创海报…Sphere是LipoSucction2 MYWORKBOOK Ver0.34 test.xlsm 368718 Bytes Wb Object 360282 Bytes after:MYWORKBOOK Ver0.34 test.xlsm 368718 Bytes Wb Object 360281 Bytes之前和之后的LipoSucction2 MYWORKBOOK Ver0.34 test.xlsm 368718 Bytes我想它大约减少了1KB,但我仍然有一个完全空的工作簿,只有一张纸,这个东西是368KB。还有其他想法吗?WB对象是什么?我怎样才能杀死它?看起来它主要来自vbaProject.bin(在一个“xl”文件夹中),但我没有添加更多的文本或任何内容。因此,我不确定是什么让它简单地通过删除所有的工作表而增长。它在那里存储了一些东西,历史记录或者日志之类的东西。我想把它删除!!!vbaProject.bin不是工作簿中的宏吗?我假设您在问题中发布的宏存储在此工作簿中。如果是这样的话,这可能就是占据房间的原因。删除宏,看看它是否有帮助?若这对任何人都有帮助,我不知道它在做什么,但它似乎删除了一些vbaProject.bin文件,但我测试了我的无宏(空白)66KB文件,它并没有将其清除回新的17KB。我认为它只清理实际的VBA代码部分,而不会清理vbaProject.bin文件中填充的任何其他垃圾。不过这只是个开始。