VBA EXCEL Tạo UserForm tìm kiếm theo chuyên mục, kết quả được hiển thị ở Listbox trên form
Giaoan.link chia sẻ cách sử dụng VBA EXCEL Tạo UserForm tìm kiếm theo chuyên mục, kết quả được hiển thị ở Listbox trên form.
Các bài học excel ứng dụng:
- Ổ C đầy Di chuyển dữ liệu ZALO sang Ổ D hoặc ổ khác một cách dễ dàng Không lo zalo báo đầy ổ đĩa
- Google sheet webapp|Nhập liệu-Quản lý khách hàng – Click tên hiển thị popup thông tin thêm – Print
- Google sheet webapp | Multi Load table data từ google sheet lên web và frezee header of table.
- HTML WEBAPP CSS -Mô phỏng hệ mặt trời -Trái đất -Mặt trăng đơn giản trên nền vũ trụ đen sao lấp lánh
- Google sheet Webapp Script | Tìm kiếm, lọc và In chi tiết thông tin sản phẩm của mã Khách hàng
- Google sheet Apps script | Data Entry Popup From – Thêm mới – Chỉnh sửa – Xóa
- Google sheet Webapp Script | Quản lý đặt xe cho chuyến đi – Tài xế cập nhật hoàn thành thông tin
- Apps script Webapp | Lấy giá trị Input hiển thị lên – Web Get value input field display on web
- Google sheet Apps script | Todo List and Send mail – Tạo danh sách nhắc việc và gửi mail
- Web App Script | Bộ Icon CSS Rất dễ lập trình cho giao diện webapp
Bạn xem video hướng dẫn theo từng bước bên dưới, kết hợp code VBA mình chia sẻ để việc thực hành nhanh hơn.
Code VBA trong ví dụ này:
'Kenh youtube: NetmediaCCTV chia se kien thuc
Option Explicit 'Allows users to automatically check for unconventional variables
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub cmdSearch_Click()
Dim thongbao1 As String
Dim thongbao2 As String
Dim thongbao3 As String
Dim thongbao4 As String
'assign values to variables thongbao1, thongbao2, thongbao3,thongbao4
thongbao1 = "Vui lòng nh" & ChrW(7853) & "p giá tr" & ChrW( _
7883) & " tìm ki" & ChrW(7871) & "m.."
thongbao2 = "Vui lòng ch" & ChrW(7885) & "n m" & ChrW(7909) & _
"c tìm ki" & ChrW(7871) & "m."
thongbao3 = "D" & ChrW(7919) & " li" & ChrW(7879) & "u " & _
ChrW(273) & ChrW(432) & ChrW(7907) & "c tìm th" & ChrW(7845) & "y"
thongbao4 = "Không tìm th" & ChrW(7845) & "y d" & ChrW(7919) _
& " li" & ChrW(7879) & "u."
'condition for if blank TextBox1
If Me.TextBox1.Value = "" Then
Application.Assistant.DoAlert "Thông báo", thongbao1, msoAlertButtonOK, msoAlertIconInfo, msoAlertDefaultFirst, msoAlertCancelFirst, False
Exit Sub
End If
Application.ScreenUpdating = False 'used to update screen ON/OFF
Dim sh As Worksheet ' Database sheet
Dim sht As Worksheet 'SearchData sheet
Set sh = ThisWorkbook.Sheets("Database")
Set sht = ThisWorkbook.Sheets("SearchData")
Dim ish As Long 'for the last non-blank row number available in Database sheet
Dim isht As Long 'for the last non-blank row number available in SearachData sheet
Dim iColumn As Integer 'To select column number in Database sheet
ish = ThisWorkbook.Sheets("Database").Range("B" & Application.Rows.Count).End(xlUp).Row
'condition if blank ComboBox1
If Me.ComboBox1.Value = Empty Then
Application.Assistant.DoAlert "Thông báo", thongbao2, msoAlertButtonOK, msoAlertIconInfo, msoAlertDefaultFirst, msoAlertCancelFirst, False
Exit Sub
End If
'to generate column number when you select combobox value, which must be same to same as worksheet value i.e
iColumn = Application.WorksheetFunction.Match(Me.ComboBox1.Value, sh.Range("B3:F3"), 0)
'condition for Remove filter from Database worksheet
If sh.FilterMode = True Then
sh.AutoFilterMode = False
End If
'now Apply filter on Database worksheet
If Me.ComboBox1.Value = "SO DIEN THOAI" Then
'as SO DIEN THOAI is numeric value so Criteria1 = Me.TextBox1.Value for exact match
sh.Range("B3:F" & ish).AutoFilter Field:=iColumn, Criteria1:=Me.TextBox1.Value
Else
'now search for few keywords for others value of combobox1
sh.Range("B3:F" & ish).AutoFilter Field:=iColumn, Criteria1:="*" & Me.TextBox1.Value & "*"
'now filtered in Database sheet
End If
'now clear SearchData Sheet if anything present in the sheet
sht.Cells.Clear
'now copy the filter data from Database sheet
'paste it into SearchData sheet in A1 cell
sh.AutoFilter.Range.Copy sht.Range("A1")
'to false copycutmode
Application.CutCopyMode = False
'now find out the last non-blank row number from SearchData for Re-Populate ListBox
isht = sht.Range("A" & Application.Rows.Count).End(xlUp).Row
'now Populate listbox from SearchData Sheet
Me.ListBox1.ColumnCount = 5
Me.ListBox1.ColumnWidths = "30,100,50,100,150"
'condition msgbox if data found
If isht > 1 Then
Me.ListBox1.RowSource = "SearchData!A2:E" & isht
Application.Assistant.DoAlert "Thông báo", thongbao3, msoAlertButtonOK, msoAlertIconInfo, msoAlertDefaultFirst, msoAlertCancelFirst, False
Else
'MsgBox "No record found."
Application.Assistant.DoAlert "Thông báo", thongbao4, msoAlertButtonOK, msoAlertIconWarning, msoAlertDefaultFirst, msoAlertCancelFirst, False
End If
sh.AutoFilterMode = False
Application.ScreenUpdating = True
End Sub
Private Sub cmdShowAll_Click()
' ---------- Show All ---------------
Dim sh As Worksheet
Set sh = Sheets("Database")
Dim iRow As Long
iRow = sh.Range("C" & Rows.Count).End(xlUp).Row
'to populate listbox from Database sheet
With Me.ListBox1
.ColumnCount = 5
.ColumnHeads = True
.ColumnWidths = "30,100,50,100,150"
.RowSource = "Database!B4:F" & iRow
End With
'Now run & See
End Sub
Private Sub UserForm_Initialize()
'to load listbox1 when show this userform
Dim iRow As Long
iRow = Sheet1.Range("C" & Rows.Count).End(xlUp).Row 'to find out last non blank row number
With Userform1
' to add item on ComboBox1
.ComboBox1.AddItem "HO VA TEN" ' before write see from worksheet same to same
.ComboBox1.AddItem "LOP"
.ComboBox1.AddItem "SO DIEN THOAI"
.ComboBox1.AddItem "DIA CHI"
'to clear filter from sheets
ThisWorkbook.Sheets("Database").AutoFilterMode = False
ThisWorkbook.Sheets("SearchData").AutoFilterMode = False
'to clear the SearchData Sheet
ThisWorkbook.Sheets("SearchData").Cells.Clear
'-----------------------------------------------
'Now Populate ListBox1
.ListBox1.ColumnCount = 5
.ListBox1.ColumnHeads = True
.ListBox1.ColumnWidths = "30,100,50,100,150"
'condition
If iRow > 1 Then 'means if data present in database then
.ListBox1.RowSource = "Database!B4:F" & iRow
Else
.ListBox1.RowSource = "Database!B4:F4"
End If
End With
End Sub