Lọc theo List box trong Userform

Liên hệ QC

newlove

Thành viên mới
Tham gia
27/12/19
Bài viết
28
Được thích
0
Thật bó tay nên đính kèm lên đây nhờ các cao thủ giúp
Trong userform
Tìm kiếm và lọc dữ liệu trong Database
Mình không hiểu vì sao sau khi làm các button xong, sau đó làm thêm button search để tìm kiếm ra dữ liệu để sửa thì lại không được
Nhờ anh chị chỉ giáo giúp và xin code cho txtsearch trong file đính kèm.

Tks all
 

File đính kèm

  • Test # - Copy.xlsm
    41.9 KB · Đọc: 3
  • hinh anh.png
    hinh anh.png
    252.9 KB · Đọc: 19
Private Sub txtSearch_Change()
Call TimKiem_VT
End Sub

Sub TimKiem_VT()
a = 8
Z = 100
Dim sArray, Arr, Tmp, Tmp1, Tmp2, i As Long
With Sheets("dmkho")
sArray = .Range(Range("D" & a), Range("D" & z).End(xlUp)).Resize(, 7).Value
ReDim Arr(1 To UBound(sArray, 1), 1 To 1)
For i = 1 To UBound(sArray, 1)
Arr(i, 1) = Format(i, "000") & " " & Trim(UCase(sArray(i, 1))) & _
" [ " & UCase(sArray(i, 2)) & " ]" & " [ " & UCase(sArray(i, 3)) & " ]" & _
" [ " & UCase(sArray(i, 4)) & " ]" & " [ " & UCase(sArray(i, 6)) & " ]" & _
" [ " & UCase(sArray(i, 7)) & " ]"
Next
Tmp1 = Application.Transpose(Arr)
Tmp1 = Filter(Tmp1, UCase(Me.txtSearch), 1)
Me.LstDatabase.List() = Tmp1
End With
End Sub

bạn thêm đoạn code này vào cho o Textbox txtSearch thử xem
 
Lần chỉnh sửa cuối:
Xem lại giúp với qtm
Vì khi copy vào file, khi mở userform chọn vào texSearch lại báo lỗi sub timkiem_VT,
Có thể cho code vào đính kèm file được ko bạn

Cám ơn b nhiều
 
Xem lại giúp với qtm
Vì khi copy vào file, khi mở userform chọn vào texSearch lại báo lỗi sub timkiem_VT,
Có thể cho code vào đính kèm file được ko bạn

Cám ơn b nhiều
thì bạn phải viết cái sub Timkiem_VT đó vào chứ . copy paste vào trong Form (copy paste vào module là lỗi)
Mã:
Sub TimKiem_VT()
a = 8
Z = 100
Dim sArray, Arr, Tmp, Tmp1, Tmp2, i As Long
With Sheets("dmkho")
sArray = .Range(Range("D" & a), Range("D" & z).End(xlUp)).Resize(, 7).Value
ReDim Arr(1 To UBound(sArray, 1), 1 To 1)
For i = 1 To UBound(sArray, 1)
Arr(i, 1) = Format(i, "000") & " " & Trim(UCase(sArray(i, 1))) & _
" [ " & UCase(sArray(i, 2)) & " ]" & " [ " & UCase(sArray(i, 3)) & " ]" & _
" [ " & UCase(sArray(i, 4)) & " ]" & " [ " & UCase(sArray(i, 6)) & " ]" & _
" [ " & UCase(sArray(i, 7)) & " ]"
Next
Tmp1 = Application.Transpose(Arr)
Tmp1 = Filter(Tmp1, UCase(Me.txtSearch), 1)
Me.LstDatabase.List() = Tmp1
End With
End Sub
 

File đính kèm

  • Edit Test # - Copy.xlsm
    34.5 KB · Đọc: 13
Lần chỉnh sửa cuối:
Cám ơn qtm nhé
Mình cần phải tìm hiểu thêm, do textsearch chạy ok
nhưng các buttom khác lại ko chạy đc, mình cg dần hiểu được tại sao trước đó mình đưa code vào textsearch lại ko được do liên quan đến các buttom khác.
cần phải tìm hiểu lại,
dù sao cám on qtm nhiều
 
Web KT
Back
Top Bottom