• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

excel cok yavas calısıyor

K

kneehot

Katılım
4 Ekim 2007
Mesajlar
632
Excel Vers. ve Dili
OFFİCE 365
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 :)
 
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

.
 
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
 
Ö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

.
Genişletmek için tıkla ...

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.
 
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 :)
Genişletmek için tıkla ...
.


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.

.
 
Ö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

.
Genişletmek için tıkla ...

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.
 
Ç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.
 
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.
Genişletmek için tıkla ...

Ç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ü.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst