VBA - Hızlandırma

[NLina]

Merhabalar,

Ekte paylaştığım Excel dosyasında LOG kaydı tutması için VBA koduna biraz ekleme yaparak detaylandırdım.

Fakat büyük seçimler yaparken aşırı miktarda RAM alıyor.

Örnek olarak,

A sütunundan BA sütununa kadar geniş çaplı seçim yapınca bir süre kilitleniyor.


Bu durumun önüne geçebilecek bir şeyler var mıdır acaba.

İyi çalışmalar ve sağlıklı günler dilerim

 

[Muzaffer Ali]

Merhaba.
Örnek dosyanızda ne bir veri ve ne de kod var boş dosya eklemişsiniz.

 

[mozdem]

Merhabalar,

Ekte paylaştığım Excel dosyasında LOG kaydı tutması için VBA koduna biraz ekleme yaparak detaylandırdım.

Fakat büyük seçimler yaparken aşırı miktarda RAM alıyor.

Örnek olarak,

A sütunundan BA sütununa kadar geniş çaplı seçim yapınca bir süre kilitleniyor.


Bu durumun önüne geçebilecek bir şeyler var mıdır acaba.

İyi çalışmalar ve sağlıklı günler dilerim

Dosyanız boş olduğundan net cevap veremiyorum.
aşağıdaki kodları kullanarak bir ihtimal sorunuzun cevabı olduğunu düşünüyorum

Sub ornek
Application.Calculation = xlManual
.....
Kodlar
.....
Application.Calculation = xlCalculationAutomatic
End sub

 

[NLina]

Merhabalar,

Yanlış dosya yüklediğim için kusuruma bakmayın lütfen.

Excel in VBA kısmına ekledim ve ek olarak not defterine ekleyip yükledim.

İyi çalışmalar ve sağlıklı günler dilerim

 

[Muzaffer Ali]

Kodları aşağıdakilerle değiştirin.

Dim eski As String

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Sh.Name <> "Log" Then
        Set Sayfa = ThisWorkbook.Sheets("Log")
        With Sayfa
            satir = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
            .Cells(satir, 1) = Format(Now, "dd.mm.yyyy")
            .Cells(satir, 2) = Format(Now, "hh:mm:ss")
            .Cells(satir, 3) = Sh.Name
            .Hyperlinks.Add .Cells(satir, 3), "", "=" & .Cells(satir, 3) & "!" & Target.Address(0, 0)
            .Cells(satir, 4) = Target.Address(0, 0)
            .Hyperlinks.Add .Cells(satir, 4), "", "=" & .Cells(satir, 3) & "!" & .Cells(satir, 4)
            .Cells(satir, 5) = eski
            .Cells(satir, 6) = Target.Text
            .Cells(satir, 7) = Environ("UserName")
            .Cells(satir, 8) = Application.UserName
            .Cells(satir, 9) = Environ("Computername")
            
        End With
    End If
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    eski = Target(1, 1).Text
End Sub

 

[NLina]

Merhabalar Muzaffer bey,

Destekleriniz için teşekkür ederim.

İyi çalışmalar ve sağlıklı günler dilerim