Thursday, June 2, 2016

Cari Data/Filter Data Dengan 2 Kreteria Tampil Di Listbox

Cari data dengan dengan dua kreteria menggunakan combobox bertingkat seperti terlihat pada gambar gif diatas..!!  Mau scriptnya..!!??  ikuti langkah-langkahnya yeah..


Baca Terlebih dahulu Posting agar lebih matang memahaminya
  1. Cara Membuat Range Dinamis
  2. Tampilkan Data di ListBox di UserForm VBA Excel
Karena tahap awal sebelum membuat Combobox bertingkat untuk mencari data/menfilter data dengan 2 kreteria haruslah terlebih dahulu membuat range dan menampilakan data pada Listbox. 

Langkah-langkah Cari Data/Filter Data Dengan 2 Kreteria menggunakan Combobox dan Tampil Di Listbox :
  • Download Sample disini : Cari Data-Combobox Bertingkat 
  • Buka Visual Basic dan rangcanglah sesuai dengan tampak pada gambar format gift diatas
  • Sesuiakan Properties sebagai berikut
  • Tempat Kode Berikut pada userform dimana ajha, untuk menampilkan data pada Listbox1
Sub ListData1()
With UserForm1.ListBox1
.ColumnCount = 6
.ColumnHeads = False
.ColumnWidths = "50"
.RowSource = "RDATA"
.BoundColumn = 0
End With
End Sub
  • Tempatkan kode berikut ini pada userform dimana ajha untuk Kategori
Sub Kategori()
Dim i As Integer
Dim Ws As Worksheet: Set Ws = Sheet1
With UserForm1.ComboBox1
For i = 3 To 6
.AddItem Ws.Cells(2, i)
Next i
End With
End Sub
  • Tempatkan Kode dibawah ini pada Userform_Initialize()
Private Sub UserForm_Initialize()
Call ListData1
Call Kategori
Call RemoveCaption(UserForm1)
End Sub
  • Tempatkan Kode dibawah ini pada Combobox1_Change()
Private Sub ComboBox1_Change()
Dim i As Integer
Dim Ws As Worksheet: Set Ws = Sheet1
Dim Cb As String
Dim tmp As String
Cb = ComboBox1.Value
ComboBox2.Clear
Select Case Cb
Case "JENIS KELAMIN"
With UserForm1.ComboBox2
For i = 3 To Cells(Rows.Count, 3).End(xlUp).Row
If InStr(1, tmp, Ws.Range("C" & i) & ";") = 0 Then
         .AddItem Ws.Range("C" & i)
        tmp = tmp & Ws.Range("C" & i) & ";"
            End If
        Next i
    End With
Case "TANGGAL"
With UserForm1.ComboBox2
For i = 3 To Cells(Rows.Count, 4).End(xlUp).Row
If InStr(1, tmp, Ws.Range("D" & i) & ";") = 0 Then
         .AddItem Ws.Range("D" & i)
        tmp = tmp & Ws.Range("D" & i) & ";"
            End If
        Next i
    End With
Case "BULAN"
With UserForm1.ComboBox2
For i = 3 To Cells(Rows.Count, 5).End(xlUp).Row
If InStr(1, tmp, Ws.Range("E" & i) & ";") = 0 Then
         .AddItem Ws.Range("E" & i)
        tmp = tmp & Ws.Range("E" & i) & ";"
            End If
        Next i
    End With
Case "TAHUN"
With UserForm1.ComboBox2
For i = 3 To Cells(Rows.Count, 6).End(xlUp).Row
If InStr(1, tmp, Ws.Range("F" & i) & ";") = 0 Then
         .AddItem Ws.Range("F" & i)
        tmp = tmp & Ws.Range("F" & i) & ";"
            End If
        Next i
    End With
End Select
End Sub
  • Masih pada Combobox1 Perhatikan gambar berikut, Bagian yang saya merahkan..!!
  • Tempatkan Kode dibawah ini pada Combobox2 
Private Sub ComboBox2_Change()
Sheets("DATA").Range("K2").Value = UserForm1.ComboBox2.Text
End Sub
  • Tempatkan Kode dibawah ini pada Private Sub Label2_Click, Untuk Tombol Cari Data
Private Sub Label2_Click()
Dim Ws As Worksheet: Set Ws = Sheets("DATA")
Dim WsRekap As Worksheet: Set WsRekap = Sheets("LAPORAN")
Dim R As Range: Set R = Ws.Range("RDATA")
Dim RFilter As Range: Set RFilter = Ws.Range("K1:K2")
Dim RCari As Range: Set RCari = Ws.Range("K2")
Dim C As Variant
If Ws.FilterMode Then Ws.ShowAllData
If UserForm1.ComboBox2.Text = "" Then
    MsgBox "Pilih Rekap Laporan Terlebih Dahulu..!!", 64, "Filter Data"
    Exit Sub
End If
        UserForm1.ComboBox2.Text = RCari
        R.AdvancedFilter Action:=xlFilterCopy, _
            CriteriaRange:=RFilter, CopyToRange:=WsRekap.Range("B3:G3"), Unique:=False
ListBox1.RowSource = "RLAPORAN"
End Sub
  • Tempatkan Kode dibawah ini pada , Untuk tombol Tampil Semua data di Listbox
Private Sub Label3_Click()
Call ListData1
End Sub
Jika masih gagal paham baca yang disini ajha lebih banyak gambarnya 

15 komentar

terimakasih buat pestinganya sangant membantu pak,

Sma2 pak Samsudin Eltibiz... Semoga dapat dikembangkan lagi... Bila ada Aplikasi VBA excel mhon bisa di share ke email saya senbakusen@gmail.com

ass. pak koq ada error di
Private Sub UserForm_Initialize()
Call ListData1
Call Kategori
Call RemoveCaption(UserForm1)
End Sub

yg Call RemoveCaption(Userform1) itu untuk apa mas, errornya d situ

Call RemoveCaption(Nama_UserForm) untuk menyembunyikan header UserForm..
Laporan Errornya bgaimana?

compile error: sub or function not difined
saya coba hapus yg "Call RemoveCaption(Nama_UserForm)" malah bisa jalan

Mantap... hapus saja x... cari jalan mudah saja...

koq jd bilang mantaf mas... orang saya bingung... tp makasih banyak ilmunya mas, semoga jd amal ibadah.. amin.
izin terus belajar dari sini mas

lanjutkan....!! bila ada kendala.. contact lagi..

Mas mau nnya bedanya yg 2 kriteria dengan combobox bertingkat apa ya kok sya liat hampir sama ya??,

Oia mas, setelah di filter bisa ngk kita tambahin tombol print, jadi data yg di print hanya yg terfilter?

Sama saja mas Syamsul Arifin..
saya bikin dua Judul posting karena untuk mencari target pencarian Google saja...

Untuk tombol print bisa ditambahkan.. dengan sheet hasil pencarian atau sheet hasil filter untuk perintah printnya...

Saya mencoba koding nya di database lain mas, tetapi selalu bermasalah di koding yang ini:
R.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=RFilter, CopyToRange:=WsRekap.Range("B3:G3"), Unique:=False
ListBox1.RowSource = "RLAPORAN"

Saya sudah membuat hasil Advanced Filter untuk sheet yang saya namakan LAPORAN juga, tapi masih gagal. Apakah ada step yang kurang?

Kemungkinan besar ketidak cocokan range sumber data, range pencarian dan range hasil pencarian..
jika berkenan bisa kirimkan filenya ke email : senbakusen@gmail.com

Saya sudah kirim file nya ke email ya mas. Mohon bantuannya, terimakasih

kalo mau masukan semua hasil filter ke sheet gimana cara nya gan

Komentar Anda Sangat Menentukan Kelangsungan Blog ini
EmoticonEmoticon