excel Out Of Memory Sorunu - martineden-30 - 26/10/2023
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("D3" & 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?
RE: excel Out Of Memory Sorunu - atoykan - 26/10/2023
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.
RE: excel Out Of Memory Sorunu - martineden-30 - 26/10/2023
Sayın Atoykan teşekkür ediyorum.
Dediklerinizi dikkate alıp tekrar deneyeceğim...
|