Multi Seleksi Data Memindahkan Data dari ListBox ke dalam ListBox yang Lain

Bagaimana Cara nya untuk memindahkan Data yang diseleksi dari Listbox ke dalam Listbox yang lain pada pemograman VBA Excel ? Mungkin selama ini Sobat banyak yang Bingung, Hal ini tidak terlalu sulit, Karena pada kesempatn ini saya akan memberikan tutorial nya. Data dari Listbox dipindahkan ke dalam Listbox yang lain sesuai dengan yang kita pilih.

Berikut ini Langkah - Langkah nya :

• Rancang sebuah Tabel Data pada Ms.Excell, pada kali yang saya buat Tabel Data Karyawan, seperti Tampilan Beriku ini :

• Setelah selesai proses pembuatan Tabel Data nya,  Buatlah sebuah Form, Klik Tab Developer pada Ms.Excell  >> Klik Icon Visual Basic  >> Klik Kanan VBA Project >> Insert Form. lalu tambahkan beberapa toolBox pada Form :

        Sehingga Tampilan Form nya seperti di bawah ini :

•  Double Klik CmdCari, Lalu Copy Paste Koding berikut ini :

'Koding ini dibuat untuk menampilkan data dari Tabel dengan kata Kunci pencarian "Nama Jabatan "

Private Sub cmdcari_Click()

Dim rngNames As Range

    Dim arrNames

    Dim arrResults

    Dim lngRow As Long

lst1.Clear

With lst1

.AddItem

.List(.ListCount - 1, 0) = "NIK"

.List(.ListCount - 1, 1) = "NAMA KARYAWAN"

.List(.ListCount - 1, 2) = "JABATAN"

.List(.ListCount - 1, 3) = "DEPARTEMENT"

.ColumnWidths = 80 & " , " & 120 & "," & 100 & "," & 80

End With

    If txtjabatan.Value = "" Then

        MsgBox "Nama Jabatan Belum diisi..."

Me.txtjabatan.SetFocus

       

        Exit Sub

    End If

     

    With Worksheets("Sheet1")

        Set rngNames = .Range("C3", .Range("C" & Rows.Count).End(xlUp))

    End With

    With rngNames

        arrNames = Evaluate(.Address & "&CHAR(45)&ROW(" & .Address & ")")

    End With

    arrNames = Application.Transpose(arrNames)

    arrResults = Filter(arrNames, txtjabatan.Value)

        If UBound(arrResults) = -1 Then

        lst1.AddItem "Data Tidak Ada"

    Else

        For i = LBound(arrResults) To UBound(arrResults)

            lngRow = Mid(arrResults(i), InStrRev(arrResults(i), "-") + 1)

            With lst1

                .AddItem

                .List(.ListCount - 1, 0) = Worksheets("Sheet1").Range("A" & lngRow)

                .List(.ListCount - 1, 1) = Worksheets("Sheet1").Range("B" & lngRow)

                .List(.ListCount - 1, 2) = Worksheets("Sheet1").Range("C" & lngRow)

                .List(.ListCount - 1, 3) = Worksheets("Sheet1").Range("D" & lngRow)

                

            End With

        Next i

    End If

End Sub

• Double Klik Cmdsemua1, Lalu Copy Paste Koding berikut ini :

Private Sub cmdsemua1_Click()

'Deklarasi Variabel

Dim iCnt As Integer

'Data dari ListBox1 pindah ke ListBox2

    For iCnt = 1 To Me.lst1.ListCount - 1

    With lst2

    .AddItem

    .List(.ListCount - 1, 0) = lst1.List(iCnt, 0)

    .List(.ListCount - 1, 1) = lst1.List(iCnt, 1)

    .List(.ListCount - 1, 2) = lst1.List(iCnt, 2)

    .List(.ListCount - 1, 3) = lst1.List(iCnt, 3)

    End With

    Next iCnt

Me.lst1.Clear

End Sub

Double Klik Cmdsatu1, Lalu Copy Paste Koding berikut ini :

Private Sub cmdsatu1_Click()

Dim iCnt As Integer

For iCnt = 1 To Me.lst2.ListCount - 1

If Me.lst2.Selected(iCnt) = True Then

    With lst1

    .AddItem

    .List(.ListCount - 1, 0) = lst2.List(iCnt, 0)

    .List(.ListCount - 1, 1) = lst2.List(iCnt, 1)

    .List(.ListCount - 1, 2) = lst2.List(iCnt, 2)

    .List(.ListCount - 1, 3) = lst2.List(iCnt, 3)

    End With

End If

Next

For iCnt = Me.lst2.ListCount - 1 To 0 Step -1

If Me.lst2.Selected(iCnt) = True Then

Me.lst1.RemoveItem iCnt

End If

Next

End Sub

• Double Klik Cmdsatu2, Lalu Copy Paste Koding berikut ini :

Private Sub cmdsatu2_Click()

Dim iCnt As Integer

For iCnt = 1 To Me.lst1.ListCount - 1

If Me.lst1.Selected(iCnt) = True Then

    With lst2

    .AddItem

    .List(.ListCount - 1, 0) = lst1.List(iCnt, 0)

    .List(.ListCount - 1, 1) = lst1.List(iCnt, 1)

    .List(.ListCount - 1, 2) = lst1.List(iCnt, 2)

    .List(.ListCount - 1, 3) = lst1.List(iCnt, 3)

    End With

End If

Next

For iCnt = Me.lst1.ListCount - 1 To 0 Step -1

If Me.lst1.Selected(iCnt) = True Then

Me.lst1.RemoveItem iCnt

End If

Next

End Sub

• Double Klik Cmdsatu2, Lalu Copy Paste Koding berikut ini :

Private Sub cmdsemua2_Click()

Dim iCnt As Integer
    For iCnt = 1 To Me.lst2.ListCount - 1
    With lst1
    .AddItem
    .List(.ListCount - 1, 0) = lst2.List(iCnt, 0)
    .List(.ListCount - 1, 1) = lst2.List(iCnt, 1)
    .List(.ListCount - 1, 2) = lst2.List(iCnt, 2)
    .List(.ListCount - 1, 3) = lst2.List(iCnt, 3)
    End With
    Next iCnt
Me.lst2.Clear
End Sub

• Jalankan Program, lalu masukkan data pencarian pada txtjabatan dengan kata kunci " Nama Jabatan " misalnya : "SUPERVISOR " lalu klik perintah Cari.

• Data akan pada Tabel akan tampil pada Listbox1, selanjutnya pilih data yang akan dipindahkan ke dalam ListBox2, dengan mengklik perintah - perintah sesuai yang kita inginkan, maka data dalam Listbox1 akan pindah kedalam ListBox2 dan sebaliknya.

Demikian Tutorial cara menyeleksi data Dalam ListBox dan memindahkan nya kedalam ListBox yang lain sesuai data yang dipilih, tidak terlalu sulit bukan.

Selamat Mencoba...!, dan Silahkan Sobat kembangkan kembali.

                                                                                                             Salam..,