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

ahmed_ummu

Altın Üye
Katılım
28 Mart 2011
Mesajlar
731
Excel Vers. ve Dili
Excel 2010 Professional Plus 64 Bit
Altın Üyelik Bitiş Tarihi
15-10-2026
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

Altın Üye
Katılım
5 Ocak 2019
Mesajlar
572
Excel Vers. ve Dili
Ofis 365 Tr
Altın Üyelik Bitiş Tarihi
05-01-2025
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

Altın Üye
Katılım
28 Mart 2011
Mesajlar
731
Excel Vers. ve Dili
Excel 2010 Professional Plus 64 Bit
Altın Üyelik Bitiş Tarihi
15-10-2026
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

Altın Üye
Katılım
5 Ocak 2019
Mesajlar
572
Excel Vers. ve Dili
Ofis 365 Tr
Altın Üyelik Bitiş Tarihi
05-01-2025
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

Altın Üye
Katılım
28 Mart 2011
Mesajlar
731
Excel Vers. ve Dili
Excel 2010 Professional Plus 64 Bit
Altın Üyelik Bitiş Tarihi
15-10-2026
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

Altın Üye
Katılım
5 Ocak 2019
Mesajlar
572
Excel Vers. ve Dili
Ofis 365 Tr
Altın Üyelik Bitiş Tarihi
05-01-2025
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

Altın Üye
Katılım
8 Aralık 2006
Mesajlar
405
Excel Vers. ve Dili
Ofis 365 TR 64 Bit
Altın Üyelik Bitiş Tarihi
21-11-2028
Ado ile kapalı dosyada veri almayı deneyin.
Ayrıca officeniz 32 bitmi?
 

ahmed_ummu

Altın Üye
Katılım
28 Mart 2011
Mesajlar
731
Excel Vers. ve Dili
Excel 2010 Professional Plus 64 Bit
Altın Üyelik Bitiş Tarihi
15-10-2026
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

Altın Üye
Katılım
28 Mart 2011
Mesajlar
731
Excel Vers. ve Dili
Excel 2010 Professional Plus 64 Bit
Altın Üyelik Bitiş Tarihi
15-10-2026
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.
 

Ekli dosyalar

Erkan Akayay

Altın Üye
Katılım
8 Aralık 2006
Mesajlar
405
Excel Vers. ve Dili
Ofis 365 TR 64 Bit
Altın Üyelik Bitiş Tarihi
21-11-2028
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

Altın Üye
Katılım
28 Mart 2011
Mesajlar
731
Excel Vers. ve Dili
Excel 2010 Professional Plus 64 Bit
Altın Üyelik Bitiş Tarihi
15-10-2026
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

Altın Üye
Katılım
8 Aralık 2006
Mesajlar
405
Excel Vers. ve Dili
Ofis 365 TR 64 Bit
Altın Üyelik Bitiş Tarihi
21-11-2028
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

Altın Üye
Katılım
28 Mart 2011
Mesajlar
731
Excel Vers. ve Dili
Excel 2010 Professional Plus 64 Bit
Altın Üyelik Bitiş Tarihi
15-10-2026
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.
 
Üst