excel kitabım çok yer kaplıyor.

[mmtrpc]

merhaba
office2013 Türkçe.
bir süredir Excel kitabımı kaydetmekte zorlandığımı, hatta kaydedemediğimi, 6 sayfadan oluştuğunu ve içerisinde formül olmadığı halde 63 MB yer kapladığını fark ettim. bu durumu nasıl çözeceğimi bilemiyorum.
deneyimi olan arkadaşım varsa paylaşırsa sevinirim.

 

[bosislermuduru]

Merhaba, Bu sorunun çözümüne ilişkin binlerce metod vardır.
Başlangıç seviyesinde olan arkadaşlar da yararlanması amacıyla,

1- her ihtimale karşı exceli yedekle
2- excelde tablo var ise tablonun son satırı yada son sütunu kontrol et
Eğer Astronomik bir değer ise bu satırları/Sütunları sil ve exceli kaydet
Boyut düşecektir.
3- Duzelmediyse
Her sayfada
Ctrl-end tuşlarına bas, excelin götürdüğü yer Astronomik bir yer ise kontrollü bir şekilde boş verileri sil.


Genellikle ilk 3 aşamada düzelir.

4- Duzelmediyse

Yedek dosyada ;
Sayfa 1 sil kaydet boyut dusmediyse sayfa 2 yi sil kaydet dusmediyse ... Şeklinde tüm sayfaları boyut düşüne kadar sil
Boyut düşünce son sildigin sayfayı incele, ilk 3 adımı bu sayfada tekrar dene , dilersen sayfayı baştan oluştur.

5.Asama Kopya dosyasını WinRAR ile aç
Sayfa boyutlarına, nesne boyutlarına bak
Astronomik olan veriyi orjinal excellde düzelt.

 

[bosislermuduru]

Her dosyada sorun hemen hemen aynı Olsada Dosyayı driveden atabilirsen daha detaylı bakabiliriz.

 

[Leoncio]

Merhaba,
Dosyanızın bir yedeğini alınız ve aşağıdaki kodları deneyiniz. (Alıntıdır..)

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​

'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​

 

[sebahattin]

Merhaba ekcel kitapini Farklı kaydet kısmından 2 li kitap şeklinde kaydersen boyut bir miktar düşecektir