Soru Bağlı listboxlardan çoklu veri aktarımı.

[Hakan ERDOST]

Herkese merhaba . Şöyle bir sıkıntım var. Mantığını tam kuramadım. İzah edeyim; Form üzerinde iki adet listbox ve diğer nesnelerim var. Bunlardan Listbox2 de sınıf listem var ve buradan öğrencileri toplu seçebiliyorum ve veri aktarabiliyorum. Listbox3 yerine daha önce combobox kullanıyordum fakat daha hızlı ve çoklu seçim yapabildiğim için listboxa geçmek istedim. Listbox3 te ise comboboxa bağlı olarak kazanım listeliyorum. İstediğim ise Listbox2 de tüm sınıfı seçtim varsayalım. İlgili nesnelerdeki verileri toplu olarak aktarırken listbox3 teki toplu seçimi (yada seçili olan verileri) alt alta nasıl aktarabilirim. Örneğin Ahmeti seçtim; Ahmet,Sınıf düzeyi, ders, konu, verilerinden sonra diyelim ki listbox3 te üç kazanım işaretli; sırasıyla ve alt alta aktardıktan sonra seçili ikinci kişiye geçip aynı şekilde verileri aktarmak istiyorum. Kodum aşağıda; Nasıl bir ilave ya da döngüyü tamamen mi değiştirmek lazım. Kuramadım mantığını...

Private Sub CommandButton5_Click()
Dim say As Integer, i As Integer, s As Integer
Sheets("ÖDEV_VERİTABANI").Select
say = 0
For i = 0 To ListBox2.ListCount - 1
If ListBox2.Selected(i) = True Then say = say + 1
Next
If say = 0 Then
  Me.ListBox2.SetFocus
  MsgBox "Lütfen çoklu ÖĞRENCİ seçin"
  Exit Sub
End If
If Trim(ComboBox2.Value) = "" Then
  Me.ComboBox2.SetFocus
  MsgBox "Lütfen  ödev vereceğiniz DERSİ seçin"
  Exit Sub
End If
If Trim(ComboBox4.Value) = "" Then
  Me.ComboBox4.SetFocus
 MsgBox "Lütfen bir KONU seçin"
  Exit Sub
End If
If Trim(ListBox3) = "" Then
  Me.ListBox3.SetFocus
  MsgBox "Lütfen  konuya ait bir KAZANIM seçin"
  Exit Sub
End If
s = IIf(Range("A2") = "", 1, [a65536].End(xlUp).Row)
For i = 0 To ListBox2.ListCount - 1
If ListBox2.Selected(i) = True Then
s = s + 1
Cells(s, 1) = s - 1
Cells(s, 2) = ListBox2.List(i)
Cells(s, 3).Value = ComboBox7.Value
Cells(s, 4).Value = ComboBox2.Value
Cells(s, 5).Value = ComboBox4.Value
Cells(s, 6).Value = ListBox3.List(i, 0) & ","
Cells(s, 7).Value = TextBox3.Value
Cells(s, 8).Value = TextBox4.Value
Cells(s, 9).Value = ComboBox3.Value
ListBox2.Selected(i) = False
End If
Next
ComboBox2 = ""
ComboBox4 = ""
TextBox3 = ""
TextBox4 = ""
ComboBox3 = ""
    MsgBox "Kayıt işlemi tamamlanmıştır.", vbInformation, "Kayıt İşlemi"
UserForm_Initialize

Sheets("ÖDEV_VERİTABANI").Select
End Sub

 

[Hakan ERDOST]

Yapmak isteğim aslında daha basitçe Listbox1 de çoklu seçebildiğim; Ali,Ahmet,Ayşe vb oluşan isim listem var. İkinci listboxumda da çoklu seçim yapabildiğim meyveler olsun. Örneğin Elma,Ayva, Armut vb. Listbox1'in tamamını seçtim, lİtbox2'den de Elma ve Armutu seçtim. Döngü Ali den başlayıp aradaki nesne verileri alıp listbox2'ye geldiğinde Elmayı alıp devamındaki nesneleri alıp ikinci seçime geçmeden aynı verileri tekraren alıp sadece Armut verisi ile ikinci bir satır veri oluşuturmasını döngüde nasıl halladeceğiz.

 

[Hakan ERDOST]

Private Sub CommandButton5_Click()
Dim say As Integer, i As Integer, s As Integer, y As Integer, k As Integer
Sheets("ÖDEV_VERİTABANI").Select
say = 0
For i = 0 To ListBox2.ListCount - 1
If ListBox2.Selected(i) = True Then say = say + 1
Next
If say = 0 Then
  Me.ListBox2.SetFocus
  MsgBox "Lütfen çoklu ÖĞRENCİ seçin"
  Exit Sub
End If
If Trim(ComboBox2.Value) = "" Then
  Me.ComboBox2.SetFocus
  MsgBox "Lütfen  ödev vereceğiniz DERSİ seçin"
  Exit Sub
End If
If Trim(ComboBox4.Value) = "" Then
  Me.ComboBox4.SetFocus
 MsgBox "Lütfen bir KONU seçin"
  Exit Sub
End If
If ListBox3.Selected(y) = False Then
  Me.ListBox3.SetFocus
  MsgBox "Lütfen  konuya ait bir KAZANIM seçin"
  Exit Sub
End If
s = IIf(Range("A2") = "", 1, [a65536].End(xlUp).Row)

        For i = 0 To ListBox2.ListCount - 1
    
    
k = IIf(Range("F2") = "", 5, [f65536].End(xlUp).Row)
        For y = 0 To ListBox3.ListCount - 1
    With UserForm17
If ListBox2.Selected(i) = True And ListBox3.Selected(y) = True Then
s = s + 1
Cells(s, 1) = s - 1
Cells(s, 2) = ListBox2.List(i)
Cells(s, 3).Value = ComboBox7.Value
Cells(s, 4).Value = ComboBox2.Value
Cells(s, 5).Value = ComboBox4.Value

k = k + 1
Cells(k, 6) = ListBox3.List(y)
Cells(s, 7).Value = TextBox3.Value
Cells(s, 8).Value = TextBox4.Value
Cells(s, 9).Value = ComboBox3.Value
   End If
    End With
 
    
    Next
Next
ComboBox2 = ""
ComboBox4 = ""
TextBox3 = ""
TextBox4 = ""
ComboBox3 = ""
    MsgBox "Kayıt işlemi tamamlanmıştır.", vbInformation, "Kayıt İşlemi"
UserForm_Initialize

Sheets("ÖDEV_VERİTABANI").Select
End Sub

Kodun son hali bu. Çoklu seçim ile artık aktarabiliyorum ancak Listbox3 te listelediğim bilgilerden üsttekini seçmeden veri aktaramıyorum.Oysa listelenen verilerden istediğimi aktarmam gerekiyor. Nerde hata yapıyorum?