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