MEMBUAT PENCARIAN DATA DARI USERFORM MENGGUNAKAN TEXTBOOK TAMPIL DI LISTBOOK.

MEMBUAT PENCARIAN DATA DARI USERFORM MENGGUNAKAN TEXTBOK TAMPIL DI LISTBOK.

   Jujur Saya tidak ahli dalam menulis Artikel diblog hanya belajar secara Autodidak (aku nulisnya salah apa tidak yach agan hehe) yang jelas intinya maksud aku hanya sebagai pembelajaran saya dan mungkin ada sebagian pengunjung atau orang yang secara tidak sengaja menemukan corat coretku ini,

1. Pertama buatlah sebuah lembar kerja excel, save dengan Format " Excel macro enablet workbook, dan beri nama " cari data"

   

    2. Isikan data-data seperti berikut pada sheet1

      3. Setelah selesai buatlah userform pada menu Defloper 

          

       4. Tambahkan Label,Textbok dan lishbok dan ubalah nama pada masing-masing textbok di           popertis seperti pada gambar di bawa;

Texbok ganti nama menjadi NAMA

Lalu masukan kodenya dengan cara doble klik pada Uerform1

Private Sub UserForm_Activate()
ListBox1.Clear
ListBox1.ColumnCount = 4
With ListBox1
.AddItem
.List(.ListCount - 1, 0) = "NO"
.List(.ListCount - 1, 1) = "NAMA PENDUDUK"
.List(.ListCount - 1, 2) = "NOMOR KK"
.List(.ListCount - 1, 3) = "ALAMAT"
.ColumnWidths = 20 & "," & 90 & "," & 90
End With

Doble klik pada nama, masukan kode dibawah;

Private Sub NAMA_Change()
NAMA.Value = UCase(NAMA.Value)
On Error Resume Next
Worksheets("Sheet1").Activate
Dim rngNames As Range
    Dim arrNames
    Dim arrResults
    Dim lngRow As Long
    If NAMA.Value = "" Then
        'MsgBox "Datane durung diisi ije Kosong..."
Me.NAMA.SetFocus
       
        Exit Sub
    End If
     
    With Worksheets("Sheet1")
        Set rngNames = .Range("B3", .Range("B" & Rows.Count).End(xlUp))
    End With
    With rngNames
        arrNames = Evaluate(.Address & "&CHAR(45)&ROW(" & .Address & ")")
    End With
    arrNames = Application.Transpose(arrNames)
    arrResults = Filter(arrNames, NAMA.Value)
    ListBox1.Clear
    UserForm_Activate
    If UBound(arrResults) = -1 Then
        ListBox1.AddItem "Data Tidak Ada"
    Else
        For I = LBound(arrResults) To UBound(arrResults)
            lngRow = Mid(arrResults(I), InStrRev(arrResults(I), "-") + 1)
            With ListBox1
                .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


Doble klik pada Lisbok1 Lalu Masukan Kode dibawah;


Private Sub ListBox1_Click()
On Error Resume Next
Dim daftar As Long
Dim ws As Worksheet: Set ws = Worksheets("sheet1")
With Me.ListBox1
daftar = .ListIndex
If daftar < 1 Or daftar = .ListCount Then
Else

NAMA.Value = .List(daftar, 1)
NIK.Value = .List(daftar, 2)
ALAMAT.Value = .List(daftar, 3)

End If

End With

   Demikian Corat-coret saya dibawah ini ada filenya yach barang kali ada yang membutuhkan sebagai 

UNDUH DISINI