excel cok yavas calısıyor

kneehot · 24 Kasım 2010

selamlar arkadaslar.kullandıgım excel dosyası cok sayfalı ve formullu.bos halı yaklasık 21 mb. hesaplama yaparken yada dosyayı acıp kaparken cok yavas calısıyor.bunu hızlandırmanın bır yolu varmıdır bılgısayarı degıstırmeden

Ömer · 24 Kasım 2010

Merhaba,

Bazı durumlarda gereksiz hücrelerde veri boşluğu şişkinlik yaratabilir. Bunun için aşağıdaki kodları module kopyalayarak çalıştırınız.

Eğer durum bununla ilgili değilse tablonuzu yeniden daha sade ve daha hızlı formüllerle gerekirse makro kullanarak düzenlemenizi tavsiye ederim.

Kod:

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

.

manda · 24 Kasım 2010

yukarıda bahsi geçen yavaşlama bendede oluyor
bilmemezliğimi mazur görün bu dediğiniz kodalrı nereeye yapıştıracağız
saygılarımla

serdarsari · 24 Kasım 2010

hocam daha da yavaşladı

Ömer · 24 Kasım 2010

manda' Alıntı:
yukarıda bahsi geçen yavaşlama bendede oluyor
bilmemezliğimi mazur görün bu dediğiniz kodalrı nereeye yapıştıracağız
saygılarımla

Linki inceleyiniz..

Modül Ekleme (Resimli Anlatım)

.

kneehot · 25 Kasım 2010

Ömer' Alıntı:

Merhaba,

Bazı durumlarda gereksiz hücrelerde veri boşluğu şişkinlik yaratabilir. Bunun için aşağıdaki kodları module kopyalayarak çalıştırınız.

Eğer durum bununla ilgili değilse tablonuzu yeniden daha sade ve daha hızlı formüllerle gerekirse makro kullanarak düzenlemenizi tavsiye ederim.

Kod:

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

.

sayın ömer ilginize cok tesekkur ederım ama ıse yaramadı. makrolarla ılgılı bılgımde yok. sanırım dosyayı sadelestırtırmekten baska secenek yok. tekrar tesekkurler.

Merhum İdris SERDAR · 25 Kasım 2010

kneehot' Alıntı:
selamlar arkadaslar.kullandıgım excel dosyası cok sayfalı ve formullu.bos halı yaklasık 21 mb. hesaplama yaparken yada dosyayı acıp kaparken cok yavas calısıyor.bunu hızlandırmanın bır yolu varmıdır bılgısayarı degıstırmeden

.

1. Gereksiz biçimlendirmeleri (font, renk vs.) kaldırın.

2. Formüllerde öngörülen aralık alanlarını verilerin olduğu alan kadar belirleyin. Veya formüllerde dinamik alan kullanın.

3. Dosyada mümkün olduğunca resim, nesne kullanmayın.

4. Sayfaların satır sonuna ve sütun sonuna giderek boş gibi görünen satır ve sütunları silin.

.

gyurtalan · 18 Mayıs 2016

Ömer' Alıntı:

Merhaba,

Bazı durumlarda gereksiz hücrelerde veri boşluğu şişkinlik yaratabilir. Bunun için aşağıdaki kodları module kopyalayarak çalıştırınız.

Eğer durum bununla ilgili değilse tablonuzu yeniden daha sade ve daha hızlı formüllerle gerekirse makro kullanarak düzenlemenizi tavsiye ederim.

Kod:

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

.

Herkese merhaba. Bu makroyu uyguladım. Önceden çok yavaş çalışan dakikalarca işlem yapan hatta çoğu kez kapanan excel dosyam oldukça hızlandı. Ama bu sefer önceden 8 mb olan dosya boyutu 67 mb a kadar çıktı. Yaklaşık 70 kadar sekme var. Şunu farkettim ki her sekmede mesela 1000. satır ile 65536. satırlar arasını shift ile seçip sildiğimde dosya boyutu küçülüyor. Ama bunu 70 sekmeye tek tek uygulamakda epey uğraştırıcı olacak. Umarım ne demek istediğim anlaşılmıştır. 1000. satır ile 65536. satır arasında herhangi bir veri yok. Tamamen boş. Normalde sağdaki kaydırma çubuğunu en aşağı indirince çalışma sayfasının en altına gelir. Ama bunda 65536. satıra getiriyor. Yardımcı olursanız çok sevinirim.

aerten · 18 Mayıs 2016

Çalışma sayfasının adına fare sağ tuşu ile tıklayınız. "Tüm sayfaları seç" ile çalışma sayfalarının tümünü seçiniz. Çalışma sayfaları seçiliyken açık olan çalışma sayfasında 1000'den 65536'ya kadar seçip sonra da silem işlemini yapınız. Aynı anda 70 çalışma sayfasında da aynı satırları silecektir.

gyurtalan · 19 Mayıs 2016

aerten' Alıntı:
Çalışma sayfasının adına fare sağ tuşu ile tıklayınız. "Tüm sayfaları seç" ile çalışma sayfalarının tümünü seçiniz. Çalışma sayfaları seçiliyken açık olan çalışma sayfasında 1000'den 65536'ya kadar seçip sonra da silem işlemini yapınız. Aynı anda 70 çalışma sayfasında da aynı satırları silecektir.

Çok teşekkür ederim. Oldukça kolay oldu. Beni büyük bir sıkıntıdan kurtardınız. Dosya boyutu 6,5 mb a düştü.

excel cok yavas calısıyor

kneehot

Ömer

Moderatör

manda

serdarsari

Ömer

Moderatör

kneehot

Merhum İdris SERDAR

Moderatör

gyurtalan

aerten

gyurtalan