Question

我使用VBA在excel中运行了一个模拟，它给了我大约200个工作表和模拟数据的摘要。现在，我认识到Excel的速度变慢了。因此，我删除了大部分工作表，只有带有摘要的工作表仍然可以减少文件大小（目前大约为140mb）。不幸的是，文件大小没有显着变化。我该如何解决这个问题？

Answer 1

当我运行类似的情况时 - 我无法复制您的问题。你是如何删除表格的？这是我用来删除额外的工作表，并在保存时正确修改文件大小。

Sub DeleteSheets1()
'This macro will delete all sheets except 'sheet1'
    Dim xWs As Worksheet
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For Each xWs In Application.ActiveWorkbook.Worksheets
        If xWs.Name <> "Sheet1" Then
            xWs.Delete
        End If
    Next
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Answer 2

按Ctrl + Shift + End并确认所选区域。这是你期望的还是范围远远超出你的预期？选择您不想要/不需要的所有列，并删除此范围。从您需要保留的位置选择所有行，并删除此范围。保存文件。检查尺寸。这是你期望看到的吗？

另外，使用下面的VBA脚本重新计算每张工作表的使用范围。

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

通过VBA删除多个工作表后，Excel文件的文件大小不会改变

2 个答案: