Excel文件减肥修复终极办法----解决Excel文件打开慢的问题

iamlaosong文

Excel文件在使用过程中由于各种原因会变得越来越大，有的文件甚至存在一些问题，导致文件大，打开慢，实在让人头疼。网上有很多办法，无非是删除内容、删除对象等等，但这些办法有时难以凑效，如一些隐含的东西或者变异（变坏）的东西是无法删除的，比如建立一个数据透视表，后来又删除了，那么这个透视表虽然删除了，这个对象还是存在的（用VBA代码刷新透视表不会报错）。还有一些已经损坏的Excel文件，虽然不大，但打开特别慢，我曾碰到这样的文件，打开很慢，打开后，菜单中的单元格样式处显示的都是？（说明文件有问题），文件的内容也无法复制粘贴（编辑栏复制粘贴还是可以的），如下图：

对这样的文件如何处理呢？

下面介绍一个终极办法，这个办法的中心思想就是保存文件的有效内容，对于单个工作表文件，当然可以保存为文本或者CSV格式的文件，但多个工作表的话，如果一个个保存就太麻烦了，而且不能保存工作表内容的格式。下面的办法不仅可以保存多个工作表文件，而且能够尽可能的保存原来的工作表的格式。方法如下：

1、打开文件，删除所有不需要的内容和对象（可以按F5定位）。

2、将文另存为网页格式，最好使用单个文件网页，一个文件嘛，处理比较简单，保存后关闭Excel。

3、用Excel重新打开这个网页文件，打开后可以看到原来的工作表内容，只是新的Excel文件没有网格显示。

4、在选项中加上网格显示（见后面），再另存为Excel文件，至此文件减肥完毕。

经过这样处理的Excel文件将保留其有效内容，其它无关的一概删去（包括一些已经损坏的东西），文件会大大减小。

多个工作表同时加网格线的方法是（2007版）：选中所有工作表（按Ctrl键或者Shift键选择），打开Excel选项，选择高级中的“显示网格线”勾上，如下图：

最后说一下注意事项：

1、因为单元格宽度导致的一些日期、数字无法正常显示的（一般显示为#）要调整宽度让其显示出来，如选择自动调整列宽。文本过长显示不全，没有关系，可以不调整。

2、如Excel文件含有VBA代码，转换后的文件不再包含代码，不过可以在转换后再插入模块，将代码复制过来既可，因为原文件中包含的按钮新文件依然存在，按钮指定的宏也没变。

==============================================

上述过程也可以通过VBA编写宏来实现（点击打开下载链接），界面和代码如下：

Sub trans_file()
    
    Dim cnn, rst, cmd As Object
    Dim datFile, datWebFile, datFullName, datFullWebFile As String

    On Error GoTo Err
    thisfile = ThisWorkbook.name   '本文件的名字，这样赋值就可以随便改名了
    Worksheets("系统参数").Select
    If Cells(3, 2) = "Y" Or Cells(5, 2) = "y" Then                              '导出出库文件
        Application.ScreenUpdating = True
    Else
        Application.ScreenUpdating = False
    End If
    
    
    'If MsgBox("开始生成清分数据......", vbOKCancel, "iamlaosong") = vbCancel Then Exit Sub
    lineno = [B65536].End(xlUp).Row           '行数，文件数量
    
    For unit_num = 5 To lineno                 '文件循环
    
        datFile = Cells(unit_num, 2)                              '文件名称
        datWebFile = Left(datFile, InStr(datFile, ".")) & "mht"
        datFullName = ThisWorkbook.Path & "\" & datFile
        datFullWebFile = ThisWorkbook.Path & "\" & datWebFile
        If Dir(datFullName, vbNormal) <> vbNullString Then
            Workbooks.Open Filename:=datFullName        '打开文件
            Cells.Select
            Selection.Columns.AutoFit                   '调整列宽，防止因列宽导致日期、数值显示为#号的问题
            ActiveWorkbook.SaveAs Filename:=datWebFile, FileFormat:=xlWebArchive
            ActiveWindow.Close
            Workbooks.Open Filename:=datFullWebFile
            
            For i = 1 To Worksheets.Count
                Worksheets(i).Select
                ActiveWindow.DisplayGridlines = True
                colno = [IV2].End(xlToLeft).Column
                For j = 1 To colno
                    colName = Chr(j + 64)
                    'Debug.Print IsNumeric(Range(colName & "2"))
                    'Debug.Print Len(Range(colName & "2"))
                    If IsNumeric(Range(colName & "2")) And Len(Range(colName & "2")) >= 12 Then       '科学计数法转换成文本
                        Columns(colName & ":" & colName).Select
                        Selection.NumberFormatLocal = "000000"
                    End If
                Next j
            Next i
            Worksheets(1).Select
            datFile = "new" & Left(datFile, InStr(datFile, ".")) & "xls"
            ActiveWorkbook.SaveAs Filename:=datFile, FileFormat:=xlNormal     'xls=xlNormal,xlsx=xlOpenXMLWorkbook
            ActiveWindow.Close
        Else
            MsgBox "数据文件不存在！", vbOKOnly, "iamlaosong"
            Exit Sub
        End If
        
        'ActiveWorkbook.Save
        'ActiveWindow.Close
        Windows(thisfile).Activate
        Worksheets("系统参数").Select
        Cells(unit_num, 3) = "成功"
        'Application.StatusBar = "已完成：100.00%"

    Next unit_num
    MsgBox "处理完毕！", vbOKOnly, "iamlaosong"
    Exit Sub
Err:
    MsgBox "错误#" & Str(Err.Number) & Err.Description & "-位置： " & datFile, vbOKOnly + vbExclamation, "iamlaosong"
End Sub