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:
- Tạo hóa đơn trên Google sheet – Gửi email đính kèm hóa đơn pdf – Quản lý url hóa đơn trên danh sách
- Google sheet Ứng dụng theo dõi đơn hàng – Danh sách sản phẩm mua, trạng thái đơn hàng
- Tip on Ms Word Hướng dẫn tạo ngắt trang, xóa ngắt trang đơn lẽ hoặc toàn bộ ngắt trang trên file doc
- Google sheet | Generate QR Codes – Mã hóa nội dung Cell – Thêm hình ở giữa mã QR code
- Google sheet App Script | Tạo custom menu – Xóa tất cả dòng Rỗng trên vùng dữ liệu Nhanh chống
- Google Script Web | From upload file – Kiểm tra trùng lặp – Ghi đè hoặc Tạo phiên bản mới cho file
- Google Script Web | Trang Tìm kiếm nhiều điều kiên riêng lẽ hoặc hết hợp – Print, Xuất file PDF
- Hướng dẫn kiểm tra Bàn phím, Tháo và thay bàn phím mới cho Dell Inspirion 15 3000 series
- Google sheet webapp | Quản lý bán hàng – Chức nằn trả góp, In thông tin
- Ổ 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
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