Size gittikçe yükselen dosya..

[quman]

Merhaba arkadaşlar,

İçinde 5 adet küçük form bulunan ve kodları toplam 2-3 A4 sayfasını geçmeyen bir excel çalışma kitabım var. (Toplam 800 kb büyüklüğünde). 10 gündür üzerinde çalışıyorum. Dünden beri bir şey oldu, dosyayı hiç bir işlem yapmadan bile (herhangi bir veri girişi ya da yeni bir satır bile kod eklemeden) açıp kapattığımda dosya büyüklüğü şişiyor. Önce 2,7 Mb sonra 33 MB sonra 67 MB sonra 133 MB sonra 265 MB oldu sonra bıraktım. Ne olabilir sorun sizce? Bu arada bir bankada çalışıyorum ve her türlü güvenlik yazılımlarının olduğu bir yer, virüsten şüphelenmiyorum. Yardımlarınız için teşekkürler.

 

[Necdet]

Merhaba,

Nedenini bilmiyorum ama bende öyle sorunlarla karşılaşmıştım, aşağıdaki kodlar işe yaramıştı. Google da excel diet diye aratırsınaz aşağıdaki kodların olduğu siteyi bulursunuz.

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).Address & ":IV65536").Delete
            .Range(Cells(LastRow + 1, 1).Address & ":IV65536").Delete
        End With
    Next
     
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
     
End Sub

 

[quman]

İlginize teşekkür ederim. İyi çalışmalar.

 

[freeesss]

bu kodları nereye yapıştırıcam ?

 

[uzmanamele]

merhaba

alternatif olarak buradaki yöntemi deneyiniz.

dosya boyutunu küçültmek

 

[yalnızefe]

teşekkürler modülü ekleyip çalıştırdım 4kb. daha artış gösterdi kitabım..