Skip to main content

AccessTr.neT

Kayıt Ol

 | Facebook ile Bağlan  | Twitter İle Bağlan | Google+ İle Bağlan

excel Out Of Memory Sorunu

martineden-30
martineden-30
Excel Cevaplanmış Soruları
2
136

excel Out Of Memory Sorunu

Çözüldü #1
martineden-30
Aktif Üye
martineden-30
Bul
Aktif Üye*
Adı Soyadı:
Yaşı: 43
Konum: Ağrı
Ofis Versiyonu: -
Son Oturumu: 30/10/2023,04:28
Yorumları: 60
Konuları: 13
Kayıt Tarihi: 11/04/2010
Teşekkür Puanı: 0 
Sub aktar()

'Tbas = Now

Dim rg As Range

Dim son, sonstn, zSon, SonSatir As Long

Dim dizi As Variant

Dim puDizi As Variant

Dim iSonSutun As Integer





iSonSutun = Sayfa1.Cells(4, Columns.Count).End(xlToLeft).Column



Dim isim As String, aktif As Boolean

son = Sayfa1.Cells(Rows.Count, 4).End(xlUp).Row

'MsgBox iSonSutun

Set rg = Sayfa1.Range("4:" & iSonSutun & son)

dizi = rg

 With Application

        .DisplayAlerts = False

        .ScreenUpdating = False

        .EnableEvents = False

        .Calculation = xlCalculationManual

    End With

Sayfa37.Range("A3:N5000").Clear



m = -1

ReDim puDizi(100, 1568)



For i = 1 To UBound(dizi)

    If dizi(i, 2) = "True" Then

        isim = dizi(i, 4)

        m = m + 1

    End If

    

    

If dizi(i, 4) = isim Then

puDizi(m, 0) = m + 1

puDizi(m, 1) = dizi(i, 4)



If dizi(i, 5) <> "" Then a = dizi(i, 5)

puDizi(m, 2) = a





If dizi(i, 12) = "101" Then

puDizi(m, 3) = dizi(i, iSonSutun)

b = dizi(i, iSonSutun)

End If

If dizi(i, 12) = "119" Then

puDizi(m, 4) = dizi(i, iSonSutun)

c = dizi(i, iSonSutun)

End If

If dizi(i, 12) = "103" Then

puDizi(m, 5) = dizi(i, iSonSutun)

f = dizi(i, iSonSutun)

End If

If dizi(i, 12) = "117" Then

puDizi(m, 6) = dizi(i, iSonSutun)

d = dizi(i, iSonSutun)

End If

If dizi(i, 12) = "116" Then

puDizi(m, 7) = dizi(i, iSonSutun)

e = dizi(i, iSonSutun)

End If



If dizi(i, 12) = "106" Then

puDizi(m, 8) = dizi(i, iSonSutun)

bel = dizi(i, iSonSutun)

End If

puDizi(m, 13) = b + c + d + e + f + bel



End If

   

Next i



Sayfa37.Range("A3").Resize(m + 1, UBound(puDizi)) = puDizi

With Application

    .DisplayAlerts = True

    .ScreenUpdating = True

    .EnableEvents = True

    .Calculation = xlCalculationAutomatic

    .StatusBar = False

End With

'Sayfa37.Range("A" & m + 5 & ":N5000").Clear

Sayfa37.Range("A3:N" & m + 4).Borders.LineStyle = xlSolid

Sayfa37.Range("D3:N" & m + 4).HorizontalAlignment = xlCenter

Sayfa37.Range("B" & m + 4) = "Toplam"

Sayfa37.Range("d" & m + 4) = Application.WorksheetFunction.Sum(Sayfa37.Range("D3Lol" & m + 3))

Sayfa37.Range("e" & m + 4) = Application.WorksheetFunction.Sum(Sayfa37.Range("e3:e" & m + 3))

Sayfa37.Range("f" & m + 4) = Application.WorksheetFunction.Sum(Sayfa37.Range("f3:f" & m + 3))

Sayfa37.Range("g" & m + 4) = Application.WorksheetFunction.Sum(Sayfa37.Range("g3:g" & m + 3))

Sayfa37.Range("h" & m + 4) = Application.WorksheetFunction.Sum(Sayfa37.Range("h3:h" & m + 3))

Sayfa37.Range("i" & m + 4) = Application.WorksheetFunction.Sum(Sayfa37.Range("i3:i" & m + 3))

Sayfa37.Range("n" & m + 4) = Application.WorksheetFunction.Sum(Sayfa37.Range("n3:n" & m + 3))



With Sayfa37.Range("n3:n" & m + 4)

            .Interior.Color = RGB(217, 217, 217)

            .Font.Bold = True

            .Font.Size = 12

            .HorizontalAlignment = xlCenter

            .Borders.LineStyle = xlSolid

End With

 With Sayfa37.Range("A" & m + 4 & ":N" & m + 4)

            .Interior.Color = RGB(217, 217, 217)

            .Font.Bold = True

            .Font.Size = 12

            .HorizontalAlignment = xlCenter

            .Borders.LineStyle = xlSolid

            

        End With



zSon = Sayfa37.Cells(Rows.Count, 14).End(xlUp).Row '14 ==> N sütunu

Sayfa37.Range("N3") = "=sum(D3:M3)"

Sayfa37.Range("N3:N" & zSon).FillDown



'Başlık Yazdırma

Sayfa37.Cells(1, 1) = Worksheets("Ayar").Cells(7, 1) & Chr(10) & UCase(Replace(Replace(Format(Worksheets("Ayar").Cells(1, 1), "MMMM"), "ı", "I"), "i", "İ") & " " & "AYI EK DERS ÇİZELGESİ" & " (" & Worksheets("ayar").Cells(15, 1) & ")")





'Onaylayan bilgisi

 SonSatir = Sheets("Puantaj2").Cells(Rows.Count, 1).End(xlUp).Row 'Dolu son Satırı Bul

'Tarih Yazdır

Sayfa37.Range(Sayfa37.Cells(SonSatir + 4, 11), Sayfa37.Cells(SonSatir + 4, 13)).Merge 'Hücre birleştir

Sayfa37.Range(Sayfa37.Cells(SonSatir + 4, 11), Sayfa37.Cells(SonSatir + 4, 13)).HorizontalAlignment = xlCenter 'Birleştirilen Hücreleri Ortala

Sayfa37.Cells(SonSatir + 4, 11) = Date 'Birleştirilen Hücreye Tarih Bas

'Müdür YAzdır

Sayfa37.Range(Sayfa37.Cells(SonSatir + 6, 11), Sayfa37.Cells(SonSatir + 6, 13)).Merge 'Hücre birleştir

Sayfa37.Range(Sayfa37.Cells(SonSatir + 6, 11), Sayfa37.Cells(SonSatir + 6, 13)).HorizontalAlignment = xlCenter 'Birleştirilen Hücreleri Ortala

Sayfa37.Cells(SonSatir + 6, 11) = Worksheets("Ayar").Cells(5, 1)

'Unvan Yazdır

Sayfa37.Range(Sayfa37.Cells(SonSatir + 7, 11), Sayfa37.Cells(SonSatir + 7, 13)).Merge 'Hücre birleştir

Sayfa37.Range(Sayfa37.Cells(SonSatir + 7, 11), Sayfa37.Cells(SonSatir + 7, 13)).HorizontalAlignment = xlCenter 'Birleştirilen Hücreleri Ortala

Sayfa37.Cells(SonSatir + 7, 11) = Worksheets("Ayar").Cells(6, 1)



MsgBox ("Veriler Başarıyla MEB Çizelgeye aktarıldı") ' Tbit & " - " & Tbas)

End Sub

"out of memory" hatası alıyorum. Yardımcı olabilir misiniz?
martineden-30, 11-04-2010 tarihinden beri AccessTr.neT Üyesidir.
Cevapla
#2
atoykan
Uzman
atoykan
Bul
Uzman
Adı Soyadı:
Konum: İstanbul
Ofis Versiyonu: Ofis 2019 64 Bit
Son Oturumu: Bugün,09:09
Yorumları: 1.276
Konuları: 3
Kayıt Tarihi: 23/02/2020
Teşekkür Puanı: 162
Mesleğiniz: CIO, Yazılım
Out Of Memory hatası kodunuz çalışırken bilgisayarınızın bellek kapasitesinin sonuna geldiği anlamına gelir. Bütün işlemleri tek bir kodun içinde yapmak yerine işlemi parçalara ayırmayı ve kodunuzu optimize etmeyi deneyin ve işlemlerinizin sırasına göre işi biten değişkenleri boşaltıp belleğinizde yer açın.
optimize etmeye çalışırken tek bir kod yöntemine döngüye odaklanmayın. Mesela aşağıdaki kod ile kendi kodunuzu karşılaştırın örnek olarak sizin kodlarınızı kısmen optimize edecek olursak:
Kod:
Dim ws1 As Worksheet, ws2 As Worksheet, wsAyar As Worksheet
    Dim dataRange As Range
    Dim resultRange As Range
    Dim lastRow As Long
    Dim i As Long
    Dim puDizi() As Variant
    Dim m As Long
    Dim b As Double, c As Double, d As Double, e As Double, f As Double, bel As Double
    Dim isim As String
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    
    Set ws1 = ThisWorkbook.Sheets("Sayfa1")
    Set ws2 = ThisWorkbook.Sheets("Sayfa37")
    Set wsAyar = ThisWorkbook.Sheets("Ayar")
    
    lastRow = ws1.Cells(ws1.Rows.Count, 4).End(xlUp).Row
    Set dataRange = ws1.Range("A4:N" & lastRow)
    Set resultRange = ws2.Range("A3:N5000")
    resultRange.Clear
    
    m = -1
    ReDim puDizi(100, 13)
    
    For i = 1 To dataRange.Rows.Count
        If dataRange.Cells(i, 2).Value = True Then
            isim = dataRange.Cells(i, 4).Value
            m = m + 1
        End If
        
        If dataRange.Cells(i, 4).Value = isim Then
            ' Verileri işle
            If dataRange.Cells(i, 5) <> "" Then
                puDizi(m, 2) = dataRange.Cells(i, 5).Value
            End If
            
            Select Case dataRange.Cells(i, 12).Value
                Case "101"
                    b = dataRange.Cells(i, dataRange.Columns.Count).Value
                Case "119"
                    c = dataRange.Cells(i, dataRange.Columns.Count).Value
                Case "103"
                    f = dataRange.Cells(i, dataRange.Columns.Count).Value
                Case "117"
                    d = dataRange.Cells(i, dataRange.Columns.Count).Value
                Case "116"
                    e = dataRange.Cells(i, dataRange.Columns.Count).Value
                Case "106"
                    bel = dataRange.Cells(i, dataRange.Columns.Count).Value
            End Select
        End If
        
        puDizi(m, 0) = m + 1
        puDizi(m, 1) = isim
        puDizi(m, 3) = b
        puDizi(m, 4) = c
        puDizi(m, 5) = f
        puDizi(m, 6) = d
        puDizi(m, 7) = e
        puDizi(m, 8) = bel
        puDizi(m, 13) = b + c + d + e + f + bel
    Next i
    
    resultRange.Resize(m + 1, UBound(puDizi, 2)).Value = puDizi
    resultRange.Borders.LineStyle = xlSolid
    resultRange.HorizontalAlignment = xlCenter
    
    ' Diğer işlemler
    ' ...
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True
    Application.EnableEvents = True
gibi kodlarınızı sadeleştirmeyi ve örneğin önce aktarımı sonra formatlamayı yapmak gibi parçalara bölmeyi de değerlendirin.
Cevapla
#3
martineden-30
Aktif Üye
martineden-30
Bul
Aktif Üye*
Adı Soyadı:
Yaşı: 43
Konum: Ağrı
Ofis Versiyonu: -
Son Oturumu: 30/10/2023,04:28
Yorumları: 60
Konuları: 13
Kayıt Tarihi: 11/04/2010
Teşekkür Puanı: 0
Sayın Atoykan teşekkür ediyorum.
Dediklerinizi dikkate alıp tekrar deneyeceğim...
martineden-30, 11-04-2010 tarihinden beri AccessTr.neT Üyesidir.
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task