userformdaki listboxta ekleme çıkarma

[goklerhakimi]

Merhaba, ekteki dosyada bir userformum var, iki listemden birbirine ekleme çıkartma yapabilmek istiyorum. yaptıklarım listbox'ı güncellemediği için sorunlarım var.

 

[veyselemre]

Private Sub CommandButton4_Click()
    If ListBox1.ListIndex = -1 Then
        MsgBox "Önce Listeden Seçim Yapınız"
        Exit Sub
    End If
    ListBox2.AddItem ListBox1
    ListBox1.RemoveItem (ListBox1.ListIndex)
End Sub
Private Sub CommandButton5_Click()
    If ListBox2.ListIndex = -1 Then
        MsgBox "Önce Listeden Seçim Yapınız"
        Exit Sub
    End If
    ListBox1.AddItem ListBox2
    ListBox2.RemoveItem (ListBox2.ListIndex)
End Sub
Private Sub UserForm_Activate()
    With Sheets("Sheet1").Cells(2, 1)
        ListBox1.List = Range(.Offset(), .End(xlDown)).Value
        ListBox2.List = Range(.Offset(, 1), .Offset(, 1).End(xlDown)).Value
    End With
End Sub

 

[goklerhakimi]

teşekkürler sayın veyselemre. peki sheet'teki listeyi de güncelleyebiliyor muyuz bu sırada?

 

[Ferhat Pazarçevirdi]

Sn.Veyselemre konuya müdahale etmiş ama, bende bir kod eklemiş olayım. Userformun kod sayfasına ekleyiniz

Private Sub CommandButton4_Click()
If ListBox1.ListCount = 0 Then: MsgBox "Listede eleman yok", vbCritical, "UYARI": ListBox2.Selected(0) = True: Exit Sub
Set sh1 = Sheets("Sheet1")
son1 = sh1.Cells(65536, 1).End(xlUp).Row
son2 = sh1.Cells(65536, 2).End(xlUp).Row
sh1.Range("A2:A" & son1).ClearContents
sh1.Range("A1") = "Liste"
sh1.Range("B1") = "Çıkartılacaklar"
ListBox2.AddItem ListBox1.List(ListBox1.ListIndex)
sh1.Cells(son2 + 1, 2) = ListBox1.List(ListBox1.ListIndex)
ListBox1.RemoveItem ListBox1.ListIndex
For i = 1 To ListBox1.ListCount
  sh1.Cells(i + 1, 1) = ListBox1.List(i - 1)
Next i
ListBox2.ListIndex = ListBox2.ListCount - 1
Set sh1 = Nothing
Set sh2 = Nothing
End Sub
Private Sub CommandButton5_Click()
If ListBox2.ListCount = 0 Then: MsgBox "Listede eleman yok", vbCritical, "UYARI": ListBox1.Selected(0) = True: Exit Sub
Set sh1 = Sheets("Sheet1")
son1 = sh1.Cells(65536, 1).End(xlUp).Row
son2 = sh1.Cells(65536, 2).End(xlUp).Row
sh1.Range("B2:B" & son2).ClearContents
sh1.Range("B1") = "Çıkartılacaklar"
ListBox1.AddItem ListBox2.List(ListBox2.ListIndex)
sh1.Cells(son1 + 1, 1) = ListBox2.List(ListBox2.ListIndex)
ListBox2.RemoveItem ListBox2.ListIndex
For i = 1 To ListBox2.ListCount
  sh1.Cells(i + 1, 2) = ListBox2.List(i - 1)
Next i
ListBox1.ListIndex = ListBox1.ListCount - 1
End Sub
Private Sub UserForm_Initialize()
Set sh1 = Sheets("Sheet1")
son1 = sh1.Cells(65536, 1).End(xlUp).Row
If son1 <= 1 Then
MsgBox "Listeye eleman girin", vbCritical, "UYARI"
CommandButton4.Enabled = False
CommandButton5.Enabled = False
Else
son2 = sh1.Cells(65536, 2).End(xlUp).Row
sh1.Range("B2:B" & son2).ClearContents
For i = 2 To son1
ListBox1.AddItem Cells(i, 1)
Next i
ListBox1.ListIndex = 0
End If
End Sub

 

[Levent Menteşoğlu]

Alternatif olarak aşağıdaki linkide incelemenizi öneririm.

http://www.excel.web.tr/forumdisplay.php?f=128# Listboxtan Listboxa Sürükle-Bırak Uygulaması (Drag-Drop)

 

[goklerhakimi]

herkese çok teşekkür ederim, yazılan tüm kodlar ve linkler çok işime yarıyor.