Excel工作簿的大小相当大

我有一个相当大的工作簿（大约30 MB）。 我意识到这是相对较小的一些，但math似乎并没有加起来。

• 总共有19张，我有大约15-20个命名的范围。

• 除了四个以外的所有表格都有一个很小的使用范围（低于100行和25列）

• 四个中的两个是表格（最小格式） 35,000行40列，包括从单独的文件粘贴值总计大约。 20 MB。

• 其他表不是表格，也没有格式化， 9000行100列和11000行×5列。

所以我的问题是：额外的10 MB来自哪里？

编辑：

请注意，我已经把每张纸上的使用范围降到了最低限度。 此外，该工作簿是从我们的公司模板与重要的VBA复制，但该文件小于1 MB。

Answer 1

当您将不同文件中的数据复制到一个文件时，通常会出现此问题，因为Excel无法正确pipe理最后一行和最后一列数字，因此使用大量数据来存储空单元格的值。

尝试以下。

第一次尝试

使用以下Excel Diet VBA脚本来重置最大列数和行数。

Attribute VB_Name = "Module1" Option Explicit Sub ExcelDiet() Dim j As Long Dim k As Long Dim LastRow As Long Dim LastCol As Long Dim ColFormula As Range Dim RowFormula As Range Dim ColValue As Range Dim RowValue As Range Dim Shp As Shape Dim ws As Worksheet Application.ScreenUpdating = False Application.DisplayAlerts = False On Error Resume Next For Each ws In Worksheets With ws 'Find the last used cell with a formula and value 'Search by Columns and Rows On Error Resume Next Set ColFormula = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious) Set ColValue = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, _ LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious) Set RowFormula = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious) Set RowValue = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious) On Error GoTo 0 'Determine the last column If ColFormula Is Nothing Then LastCol = 0 Else LastCol = ColFormula.Column End If If Not ColValue Is Nothing Then LastCol = Application.WorksheetFunction.Max(LastCol, ColValue.Column) End If 'Determine the last row If RowFormula Is Nothing Then LastRow = 0 Else LastRow = RowFormula.Row End If If Not RowValue Is Nothing Then LastRow = Application.WorksheetFunction.Max(LastRow, RowValue.Row) End If 'Determine if any shapes are beyond the last row and last column For Each Shp In .Shapes j = 0 k = 0 On Error Resume Next j = Shp.TopLeftCell.Row k = Shp.TopLeftCell.Column On Error GoTo 0 If j > 0 And k > 0 Then Do Until .Cells(j, k).Top > Shp.Top + Shp.Height j = j + 1 Loop If j > LastRow Then LastRow = j End If Do Until .Cells(j, k).Left > Shp.Left + Shp.Width k = k + 1 Loop If k > LastCol Then LastCol = k End If End If Next .Range(.Cells(1, LastCol + 1), .Cells(.Rows.Count, .Columns.Count)).EntireColumn.Delete .Range("A" & LastRow + 1 & ":A" & .Rows.Count).EntireRow.Delete End With Next Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub 

第二次尝试

将所有数据复制到一个全新的文件并保存。