Hiển thị kết quả tìm kiếm từ 1 đến 1 trên tổng số: 1
  1. #1
    Tham gia ngày
    05 2006
    Nơi Cư Ngụ
    HCM
    Bài gởi
    1,733
    Cảm ơn
    1,811
    Được cảm ơn 4,283 lần trong 1,197 bài viết

    Làm giảm dung lượng tập tin Excel

    Sau khi sử dụng một thời gian, các bạn phát hiện tập tin Excel của mình có dung lượng lớn. Vậy làm sao để làm giảm dung lượng tập tin Excel này?
    Xin giới thiệu các bạn đoạn code của DRJ

    Code:
    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 
                 ' Tìm ô sử dụng cuối cùng với công thức và giá trị
                 ' Tìm theo cột và hàng
                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 
                 
                 ' Xác định cột cuối cùng
                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 
                 
                 ' Xác định hàng cuối
                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 
                 
                 ' Xác định xem có shapes nào nằm ngoài hàng cuối và cột cuối
                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).Address & ":IV65536").Delete 
                .Range(Cells(LastRow + 1, 1).Address & ":IV65536").Delete 
            End With 
        Next 
         
        Application.ScreenUpdating = True 
        Application.DisplayAlerts = True 
         
    End Sub
    Xin chú ý: các bạn phải UnHide các sheet trước khi thực hiện thủ tục này.

    Ngoài ra một cách hơi "cà chua" một tí là chuyển tập tin từ định dạng xls (Excel 2003 trở về trước) sang xlsx (Excel 2007 trở về sau).


    Lê Văn Duyệt
    Tập tin đính kèm Tập tin đính kèm
    thay đổi nội dung bởi: levanduyet, 11-03-12 lúc 02:50 PM


Thông tin về chủ đề này

Users Browsing this Thread

Hiện có 1 người đang xem đề tài này. (0 thành viên và 1 khách)

Bookmarks

Bookmarks

Quyền Sử Dụng Ở Diễn Ðàn

  • Bạn không thể đăng đề tài mới
  • Bạn không thể đăng trả lời
  • Bạn không thể đăng file đính kèm.
  • Bạn không thể sửa bài viết.
  •  

Mudim v0.8 Tắt VNI Telex Viqr Tổng hợp
Chính tả Bỏ dấu kiểu mới  [Bật/Tắt (F9)]