• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Kapalı Dosyadan Listbox'a Veri Aldırma

ahmed_ummu

Altın Üye
Katılım
28 Mart 2011
Mesajlar
777
Excel Vers. ve Dili
Excel 2010 Professional Plus 64 Bit
Merhaba arkadaşlar.

Kapalı olan dosyadan Listbox1'e verileri aldırıyorum. Listbox1'den bir veri seçtiğimde aşağıdaki gibi bir hata uyarısı veriyor ve kırmızı olan satırı seçiyor.

"Bu işlemi tamamlamak için yeterli bellek kaynağı yok"

Application.Workbooks.Open ThisWorkbook.Path & "\" & "kantin_çalşanları_veri.xlsx"
For sut = 2 To Application.Workbooks("kantin_çalşanları_veri").Sheets("KÇK").Range("a65000").End(xlUp).Row
If Application.Workbooks("kantin_çalşanları_veri").Sheets("KÇK").Range("a" & sut) Like ListBox1.Value Then
Application.Workbooks("kantin_çalşanları_veri").Sheets("KÇK").Range("a" & sut).Select
End If
Next sut
TextBox21.Value = ActiveCell.Offset(0, 0).Value
TextBox22.Value = ActiveCell.Offset(0, 1).Value
TextBox23.Value = ActiveCell.Offset(0, 2).Value
TextBox24.Value = ActiveCell.Offset(0, 3).Value
TextBox25.Value = ActiveCell.Offset(0, 4).Value
TextBox26.Value = ActiveCell.Offset(0, 5).Value
TextBox27.Value = ActiveCell.Offset(0, 6).Value
Application.Workbooks("kantin_çalşanları_veri").Close SaveChanges:=True

Yardımcı olursanız sevinirim.
 
Son düzenleme:
aşağıdaki gibi dener misiniz?
Not: aranan değer benzersizse bulunduğunda döngüden çıkılması için Exit For kullanıldı
select kullanmaya gerek yok doğrudan hücrenin adresini tanımlamanız daha doğru olur
kapalı kitapta çok fazla veriniz varsa dosyayı açmak zaman alabilir
eğer sayfa yapınız düzgünse (ilk 8-10 satırda düzgün veriler varsa) kapalı kitaplardan veriyi ADO ile almanız daha pratik olabilir
Kod:
Private Sub ListBox1_Click()
Set wb = Application.Workbooks.Open( ThisWorkbook.Path & "\" &  "kantin_çalşanları_veri.xlsx")
Set Syf = wb.Sheets("KÇK")
SonStr = Syf.Range("A65000").End(xlUp).Row

For sut = 2 To SonStr
    If Syf.Range("a" & sut) Like ListBox1.Value Then
       Set Rng = Syf.Range("a" & sut)
        TextBox21.Value = Rng.Offset(0, 0).Value
        TextBox22.Value = Rng.Offset(0, 1).Value
        TextBox23.Value = Rng.Offset(0, 2).Value
        TextBox24.Value = Rng.Offset(0, 3).Value
        TextBox25.Value = Rng.Offset(0, 4).Value
        TextBox26.Value = Rng.Offset(0, 5).Value
        TextBox27.Value = Rng.Offset(0, 6).Value
        Exit For
    End If
Next sut

wb.Close SaveChanges:=True
End Sub
 
aşağıdaki gibi dener misiniz?
Not: aranan değer benzersizse bulunduğunda döngüden çıkılması için Exit For kullanıldı
select kullanmaya gerek yok doğrudan hücrenin adresini tanımlamanız daha doğru olur
kapalı kitapta çok fazla veriniz varsa dosyayı açmak zaman alabilir
eğer sayfa yapınız düzgünse (ilk 8-10 satırda düzgün veriler varsa) kapalı kitaplardan veriyi ADO ile almanız daha pratik olabilir
Kod:
Private Sub ListBox1_Click()
Set wb = Application.Workbooks.Open( ThisWorkbook.Path & "\" &  "kantin_çalşanları_veri.xlsx")
Set Syf = wb.Sheets("KÇK")
SonStr = Syf.Range("A65000").End(xlUp).Row

For sut = 2 To SonStr
    If Syf.Range("a" & sut) Like ListBox1.Value Then
       Set Rng = Syf.Range("a" & sut)
        TextBox21.Value = Rng.Offset(0, 0).Value
        TextBox22.Value = Rng.Offset(0, 1).Value
        TextBox23.Value = Rng.Offset(0, 2).Value
        TextBox24.Value = Rng.Offset(0, 3).Value
        TextBox25.Value = Rng.Offset(0, 4).Value
        TextBox26.Value = Rng.Offset(0, 5).Value
        TextBox27.Value = Rng.Offset(0, 6).Value
        Exit For
    End If
Next sut

wb.Close SaveChanges:=True
End Sub

Kodlar için teşekkürler sayın halililyas.

Aşağıdaki kod satırında aynı hatayı veriyor

"Bu işlemi tamamlamak için yeterli bellek kaynağı yok"


If Syf.Range("a" & sut) Like ListBox1.Value Then
 
Son düzenleme:
Kodu tam olarak nerde kullanıyorsunuz?
Listbox da veri var mı
 
Kodu tam olarak nerde kullanıyorsunuz?
Listbox da veri var mı

Evet kodlar listbox1'de. Veriler Listbox1'e başka bir kod ile listeniyor. Listbox'dan bir veri seçtiğimde Sayfadaki verinin üzerine konumlanması gerekiyor.

If Syf.Range("a" & sut) Like ListBox1.Value Then Bu satırı seçip aşağıdaki hatayı veriyor.

"Bu işlemi tamamlamak için yeterli bellek kaynağı yok"
 
Kodu tam olarak nerde kullanıyorsunuz?
Listbox da veri var mı

Örnek bir dosya ekliyorum. Klasörün içindeki ana kitap dosyasında VBA yı açınca userform var formdaki listbox'a veriler listeleniyor. Listboxtaki verinin birini seçince KÇK sayfasından seçilen veriye ait bilgiler textboxlara gelecek.
 

Ekli dosyalar

çalışmanızı dış siteye yükleyebilir misiniz?
dosya indirme yetkim yok maalesef
 
listbox1'e kaynak olarak kapalı kitaptaki alanı gösterip sonrada kitabı kapatmışsınız
dolayısıyla artık listbox'un değeri olmuyor
kodu aşağıdaki gibi düzenleyip dener misiniz?
Kod:
Private Sub UserForm_Initialize()
xYol = ThisWorkbook.Path & "\" & "kantin_çalşanları_veri.xlsx"

Set Wb = Workbooks.Open(xYol)
Set syf = Wb.Sheets("KÇK")
SonStr = syf.Cells(syf.Rows.Count, 1).End(xlUp).Row

     With ListBox1
        .ColumnCount = 4
        .ColumnWidths = "80;60;70;40"
        .List = syf.Range("A2:D" & SonStr).Value
    End With
Wb.Close SaveChanges:=True
End Sub
 
ama işin mantığını anlamadım;
verileri kitaptan alıp sonrada veri kitapta var mı diye bakıyorsunuz?
 
ama işin mantığını anlamadım;
verileri kitaptan alıp sonrada veri kitapta var mı diye bakıyorsunuz?

Çok teşekkürler sayın haliliyas sorun çözüldü.

Veriler textboxlara alındıktan sonra o verileri başka bir forma yazdırıyorum üzerinde çalıştığım dosyada. Fazlada anlamıyorum. Siz ve sizin gibi değerli forum üye ve yöneticilerinin yardımı ile bişeyler yapmaya çalışıyorum.
 
Geri
Üst