Listbox'ta Döngü Kurma

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.

Listbox'ta 150'ye yakın verim var. Tek tek seçip diğer kodları öyle çalıştırıyorum. Bir veriyi iki kere ve bazı verileri hiç çalıştırmama ihtimalim var. Hem de tek tek seçmek çok zaman alıyor.

Listbox'da döngü kurup, İlk veriden başlayacak, diğer kodlarım çalışacak ve listbox'dan 2. veriye geçecek öyle son veriye kadar gidecek.

Örnek
For i=Listbox'daki ilk veri to Listbox'daki son veri
Kodlarım
next i

Yardımcı olursanız sevinirim.
 

DoğanD

Altın Üye
Katılım
22 Eylül 2023
Mesajlar
427
Excel Vers. ve Dili
Office 365 TR
Altın Üyelik Bitiş Tarihi
05-10-2028
Merhaba,

Aslında siz döngüyü kurmuşsunuz. Döngü verilerini aşağıdaki gibi ayarlayabilirsiniz. Önemli nokta, Listbox'ın ilk iteminin indexi sıfırdır. Dolayısıyla döngüyü sıfırdan başlatmalı ve ListCount verisinin bir aşağısında bitirmelisiniz. ListBox1.List(i) koduyla da sıradaki veriyi kullanabilirsiniz.

Kod:
For i = 0 To ListBox1.ListCount - 1
'Kodlarınız
Next i
 

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,

Aslında siz döngüyü kurmuşsunuz. Döngü verilerini aşağıdaki gibi ayarlayabilirsiniz. Önemli nokta, Listbox'ın ilk iteminin indexi sıfırdır. Dolayısıyla döngüyü sıfırdan başlatmalı ve ListCount verisinin bir aşağısında bitirmelisiniz. ListBox1.List(i) koduyla da sıradaki veriyi kullanabilirsiniz.

Kod:
For i = 0 To ListBox1.ListCount - 1
'Kodlarınız
Next i
Sayın DoğanD ilgilendiğiniz için teşekkür ederim. Benim kodlarım aşağıda. (Döngünün içinde çalışacak kodlar) Listboxtaki verilerim STAJYER_ÖĞRENCİ_PUANTAJLARI adlı klasörde hepsi kapalı dosya. Döngü ile ilk veri seçili hale gelecek ve Listbox'ın hangi isim seçili ise o dosyayı açacak ve diğer kodlar çalışacak. Sizin gönderdiğiniz kodları uyguladım ama dosya bulunamadı diye uyarı verdi. Açılan tüm kapalı dosyalardaki veri alınacak sayfanın adı "dışarıstj"

Application.Workbooks.Open Environ("UserProfile") & "\Desktop\STAJYER_ÖĞRENCİ_PUANTAJLARI\" & ListBox4.Value
Dim Say As Long
Dim Sayfa As Worksheet
Dim SonSatir As Long

Set Sayfa = Worksheets("dışarıstj")
Say = Sayfa.Cells(Sayfa.Rows.Count, "B").End(xlUp).Row
Sayfa.Range("A2:BD" & Say).Copy

With ThisWorkbook.Worksheets("SÖP")
SonSatir = .Cells(Rows.Count, "B").End(xlUp).Row + 1
.Cells(SonSatir, "B").PasteSpecial Paste:=xlValues
End With

Application.DisplayAlerts = False
Sayfa.Parent.Close SaveChanges:=True
Application.DisplayAlerts = True
 

DoğanD

Altın Üye
Katılım
22 Eylül 2023
Mesajlar
427
Excel Vers. ve Dili
Office 365 TR
Altın Üyelik Bitiş Tarihi
05-10-2028
Şu şekilde dener misiniz?

dim i as integer
For i = 0 To ListBox1.ListCount - 1
Application.Workbooks.Open Environ("UserProfile") & "\Desktop\STAJYER_ÖĞRENCİ_PUANTAJLARI\" & ListBox4.list(i) 'Listbox'ta nasıl göründüğünü bilmiyorum. "Dosyaİsmi.xlsx" şeklinde uzantısı ile görünmüyorsa; Listbox4.list(i) & ".xlsx" olarak düzenleyin.
Dim Say As Long
Dim Sayfa As Worksheet
Dim SonSatir As Long

Set Sayfa = Worksheets("dışarıstj")
Say = Sayfa.Cells(Sayfa.Rows.Count, "B").End(xlUp).Row
Sayfa.Range("A2:BD" & Say).Copy

With ThisWorkbook.Worksheets("SÖP")
SonSatir = .Cells(Rows.Count, "B").End(xlUp).Row + 1
.Cells(SonSatir, "B").PasteSpecial Paste:=xlValues
End With

Application.DisplayAlerts = False
Sayfa.Parent.Close SaveChanges:=True
Application.DisplayAlerts = True
next i
 

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
Şu şekilde dener misiniz?

dim i as integer
For i = 0 To ListBox1.ListCount - 1
Application.Workbooks.Open Environ("UserProfile") & "\Desktop\STAJYER_ÖĞRENCİ_PUANTAJLARI\" & ListBox4.list(i) 'Listbox'ta nasıl göründüğünü bilmiyorum. "Dosyaİsmi.xlsx" şeklinde uzantısı ile görünmüyorsa; Listbox4.list(i) & ".xlsx" olarak düzenleyin.
Dim Say As Long
Dim Sayfa As Worksheet
Dim SonSatir As Long

Set Sayfa = Worksheets("dışarıstj")
Say = Sayfa.Cells(Sayfa.Rows.Count, "B").End(xlUp).Row
Sayfa.Range("A2:BD" & Say).Copy

With ThisWorkbook.Worksheets("SÖP")
SonSatir = .Cells(Rows.Count, "B").End(xlUp).Row + 1
.Cells(SonSatir, "B").PasteSpecial Paste:=xlValues
End With

Application.DisplayAlerts = False
Sayfa.Parent.Close SaveChanges:=True
Application.DisplayAlerts = True
next i
Çok teşekkürler sayın DoğanD elinize sağlık. İstediğim oldu.
 
Üst