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

• 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

http://buatapplikasi.blogspot.co.id/2015/11/multi-seleksi-data-memindahkan-data.html