Bu İşlem Tamamlamak İçin Yeterli Bellek Kaynağı Yok Hatası

ahmed_ummu · 11 Aralık 2023

Merhaba arkadaşlar

Aşağıdaki kod ile kapalı dosyayı açıp, Listbox1 den seçtiğim verinin ÜP sayfasındaki verinin bulunduğu hücreye konumlanmasını istiyorum ama kırmızı renkli kod satırını seçip,

Bu İşlemiTamamlamak İçin Yeterli Bellek Kaynağı Yok hatası veriyor. Yardımcı olursanız sevinirim.

Application.Workbooks.Open ThisWorkbook.Path & "\" & "ücretli_öğretmenler.xlsx"
Sheets("ÜP").Select
For sut = 8 To [b65000].End(xlUp).Row
If Sheets("ÜP").Range("b" & sut) Like ListBox1.Value Then
Range("b" & sut).Select
End If
Next

For al = 0 To 34
Controls("textbox" & al + 8).Value = ActiveCell.Offset(0, al).Value
TextBox41.Value = ActiveCell.Offset(0, 39).Value
Next al

Greenblacksea53 · 11 Aralık 2023

Kod:

Dim wb As Workbook
Dim wsUP As Worksheet
Dim sut As Long
Dim al As Integer

Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & "ücretli_öğretmenler.xlsx")
Set wsUP = wb.Sheets("ÜP")

For sut = 8 To wsUP.Cells(Rows.Count, "B").End(xlUp).Row
    If wsUP.Range("B" & sut).Value Like ListBox1.Value Then
        wsUP.Range("B" & sut).Select
        For al = 0 To 34
            Controls("textbox" & al + 8).Value = ActiveCell.Offset(0, al).Value
            TextBox41.Value = ActiveCell.Offset(0, 39).Value
        Next al
        Exit For
    End If
Next sut

Bu kodlarla dener misin, işlemciyi ve ramı çok kullanacak kod bloğunuz vardı.

ahmed_ummu · 11 Aralık 2023

Greenblacksea53' Alıntı:

Kod:

Dim wb As Workbook
Dim wsUP As Worksheet
Dim sut As Long
Dim al As Integer

Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & "ücretli_öğretmenler.xlsx")
Set wsUP = wb.Sheets("ÜP")

For sut = 8 To wsUP.Cells(Rows.Count, "B").End(xlUp).Row
    If wsUP.Range("B" & sut).Value Like ListBox1.Value Then
        wsUP.Range("B" & sut).Select
        For al = 0 To 34
            Controls("textbox" & al + 8).Value = ActiveCell.Offset(0, al).Value
            TextBox41.Value = ActiveCell.Offset(0, 39).Value
        Next al
        Exit For
    End If
Next sut

Bu kodlarla dener misin, işlemciyi ve ramı çok kullanacak kod bloğunuz vardı.

Kodlar için teşekkürler sayın Greenblacksea5 kırmızı renkli satırda aynı hatayı verdi.

Dim wb As Workbook
Dim wsUP As Worksheet
Dim sut As Long
Dim al As Integer

Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & "ücretli_öğretmenler.xlsx")
Set wsUP = wb.Sheets("ÜP")

For sut = 8 To wsUP.Cells(Rows.Count, "B").End(xlUp).Row
If wsUP.Range("B" & sut).Value Like ListBox1.Value Then
wsUP.Range("B" & sut).Select
For al = 0 To 34
Controls("textbox" & al + 8).Value = ActiveCell.Offset(0, al).Value
TextBox41.Value = ActiveCell.Offset(0, 39).Value
Next al
Exit For
End If
Next sut

Greenblacksea53 · 11 Aralık 2023

ahmed_ummu' Alıntı:
Kodlar için teşekkürler sayın Greenblacksea5 kırmızı renkli satırda aynı hatayı verdi.

Dim wb As Workbook
Dim wsUP As Worksheet
Dim sut As Long
Dim al As Integer

Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & "ücretli_öğretmenler.xlsx")
Set wsUP = wb.Sheets("ÜP")

For sut = 8 To wsUP.Cells(Rows.Count, "B").End(xlUp).Row
If wsUP.Range("B" & sut).Value Like ListBox1.Value Then
wsUP.Range("B" & sut).Select
For al = 0 To 34
Controls("textbox" & al + 8).Value = ActiveCell.Offset(0, al).Value
TextBox41.Value = ActiveCell.Offset(0, 39).Value
Next al
Exit For
End If
Next sut

Bilgisayarınız çok eski yada çok büyük dosya ile mi çalışıyorsunuz ?

ahmed_ummu · 11 Aralık 2023

Greenblacksea53' Alıntı:
Bilgisayarınız çok eski yada çok büyük dosya ile mi çalışıyorsunuz ?

Dosya biraz büyük o nedenle çoğu sayfaları çalışma kitabının dışına alıyorum. 80 civarında sayfa var. Ama hatayı çalışma kitabının dışındaki kapalı dosyada veriyor.

Greenblacksea53 · 11 Aralık 2023

ahmed_ummu' Alıntı:
Dosya biraz büyük o nedenle çoğu sayfaları çalışma kitabının dışına alıyorum. 80 civarında sayfa var. Ama hatayı çalışma kitabının dışındaki kapalı dosyada veriyor.

Anladım hata değil sadece bellek hatası veriyor dimi,

Kod:

Dim wb As Workbook
Dim wsUP As Worksheet
Dim sut As Long
Dim al As Integer
Dim targetValue As Variant

Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & "ücretli_öğretmenler.xlsx")
If Not wb Is Nothing Then
    Set wsUP = wb.Sheets("ÜP")
    targetValue = ListBox1.Value
    Set foundCell = wsUP.Range("B:B").Find(What:=targetValue, LookIn:=xlValues, LookAt:=xlWhole)
    
    If Not foundCell Is Nothing Then
        sut = foundCell.Row
        For al = 0 To 34
            Controls("textbox" & al + 8).Value = wsUP.Cells(sut, al + 2).Value
            TextBox41.Value = wsUP.Cells(sut, 41).Value
        Next al
    Else
        MsgBox "Hedef değer bulunamadı.", vbExclamation
    End If
    
End If

Erkan Akayay · 11 Aralık 2023

Ado ile kapalı dosyada veri almayı deneyin.
Ayrıca officeniz 32 bitmi?

ahmed_ummu · 11 Aralık 2023

Greenblacksea53' Alıntı:

Anladım hata değil sadece bellek hatası veriyor dimi,

Kod:

Dim wb As Workbook
Dim wsUP As Worksheet
Dim sut As Long
Dim al As Integer
Dim targetValue As Variant

Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & "ücretli_öğretmenler.xlsx")
If Not wb Is Nothing Then
    Set wsUP = wb.Sheets("ÜP")
    targetValue = ListBox1.Value
    Set foundCell = wsUP.Range("B:B").Find(What:=targetValue, LookIn:=xlValues, LookAt:=xlWhole)
   
    If Not foundCell Is Nothing Then
        sut = foundCell.Row
        For al = 0 To 34
            Controls("textbox" & al + 8).Value = wsUP.Cells(sut, al + 2).Value
            TextBox41.Value = wsUP.Cells(sut, 41).Value
        Next al
    Else
        MsgBox "Hedef değer bulunamadı.", vbExclamation
    End If
   
End If

Evet sadece belirttiğim hatayı veriyor.

ahmed_ummu · 11 Aralık 2023

Erkan Akayay' Alıntı:
Ado ile kapalı dosyada veri almayı deneyin.
Ayrıca officeniz 32 bitmi?

64 bit
Daha önce de öneren olmuştu ama Ado hakkında pek bilgim yok.

ahmed_ummu · 11 Aralık 2023

Greenblacksea53' Alıntı:

Anladım hata değil sadece bellek hatası veriyor dimi,

Kod:

Dim wb As Workbook
Dim wsUP As Worksheet
Dim sut As Long
Dim al As Integer
Dim targetValue As Variant

Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & "ücretli_öğretmenler.xlsx")
If Not wb Is Nothing Then
    Set wsUP = wb.Sheets("ÜP")
    targetValue = ListBox1.Value
    Set foundCell = wsUP.Range("B:B").Find(What:=targetValue, LookIn:=xlValues, LookAt:=xlWhole)
   
    If Not foundCell Is Nothing Then
        sut = foundCell.Row
        For al = 0 To 34
            Controls("textbox" & al + 8).Value = wsUP.Cells(sut, al + 2).Value
            TextBox41.Value = wsUP.Cells(sut, 41).Value
        Next al
    Else
        MsgBox "Hedef değer bulunamadı.", vbExclamation
    End If
   
End If

Son gönderdiğiniz kodda da,

targetValue = ListBox1.Value satırında aynı hatayı verdi.

Olmazsa sadece bu sayfayı çalışma kitabına dahil edeceğim tekrar.

Çalışma kitabının içinde iken hata vermiyordu.

Bu kodlar ÜP sayfasıından veri alıyor. Bellek hatası olsa diğer sayfadaki işlemlerde de hata vermez mi? Kapalı olan çalışma kitabının sayfa resmini ekledim. Sadece ÜP sayfasında işlem yaparken bu hatayı veriyor. Diğer sayfalarda işlem yaparken hata vermiyor.

Erkan Akayay · 11 Aralık 2023

Bir örnek dosya hazırlayın. Kodlamayı dosyanıza göre yaparız.
Bu kadar yoğun dosyalarda Workbook.Open çekilir dert değil.

ahmed_ummu · 11 Aralık 2023

Erkan Akayay' Alıntı:
Bir örnek dosya hazırlayın. Kodlamayı dosyanıza göre yaparız.
Bu kadar yoğun dosyalarda Workbook.Open çekilir dert değil.

Kapat butonunda Appication.Quit diye kapanıyor. Değiştirmeyi unuttum. Oradan kapatacak olursanız açık dosyalarınızı da kapatmasın. Birinden fırça yemiştim bu yüzden.

Erkan Akayay · 12 Aralık 2023

Merhaba, dosyanıza bakmaya başladım. Çok emek vermişsiniz. Kodlar arasında boğuldum

Bir sürü yerde runtime error hataları alıyorum.
Böyle dosyalarda sorunun kervan yolda düzülür denmesi.
İhtiyaç duydukça farklı kod parçacıkları değişik kaynaklardan, farklı kişilerden bulunuyor.
Hepsini birleştirince ortaya düzensiz ama ihtiyacı gören bir çözüm çıkıyor.
Sorunlar yeni gereksinimler duydukça geliştirme aşamasında yaşanıyor.
İnceleyip size döneceğim.

ahmed_ummu · 12 Aralık 2023

Erkan Akayay' Alıntı:
Merhaba, dosyanıza bakmaya başladım. Çok emek vermişsiniz. Kodlar arasında boğuldum
Bir sürü yerde runtime error hataları alıyorum.
Böyle dosyalarda sorunun kervan yolda düzülür denmesi.
İhtiyaç duydukça farklı kod parçacıkları değişik kaynaklardan, farklı kişilerden bulunuyor.
Hepsini birleştirince ortaya düzensiz ama ihtiyacı gören bir çözüm çıkıyor.
Sorunlar yeni gereksinimler duydukça geliştirme aşamasında yaşanıyor.
İnceleyip size döneceğim.

Haklısınız Erkan bey, Çok karışık. Önce Sadece ekders puantajı ve veritabanı yapmak için başlamıştım. Sonradan tüm işlerimin bir arada olmasını için eklemeler yapınca böyle karışık bir hal aldı. Çok işim yarıyor 3-4 saate yapılan işleri 1-2 dakikada yapıyorum ama işte planlı yapmayınca böyle karışık oldu. Uğraştıracak ama Yardımcı olursanız çok sevinirim.

Bir de Userform12 İnitialize yordamında hiç kod olmamasına rağmen diğer formlardan daha geç açılıyor. Ona da bakarsanız çok sevinirim.

Bu İşlem Tamamlamak İçin Yeterli Bellek Kaynağı Yok Hatası

Ekli dosyalar