Hỏi về tìm kiếm dữ liệu trong listbox (2 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
maytinhvp01

maytinhvp01

Thành viên thường trực
Tham gia
27/7/13
Bài viết
390
Được thích
179
Chào các bạn! Mình đang tìm hiểu về phần tìm kiếm dữ liệu trong listbox, lên diễn đàn copy được một code cũng khá hay nhưng mình không hiểu đôi dòng code trong đó, ai biết giúp mình ý nghĩa hoạt đọng của nó được không?
Mã: 
Private Sub TextBox1_Change()
  Dim Clls As Range, Temp As Variant, i As Long
  Application.ScreenUpdating = False
  ListBox1.RowSource = ""
  If Len(Trim(TextBox1.Value)) = 0 Then Exit Sub
  With Sheet1.Range(Sheet1.[A1], Sheet1.[C65536].End(xlUp))
    Temp = .Value
    .Sort .Cells(2, 2), 1, Header:=xlGuess
    .AutoFilter 2, TextBox1.Value & "*"
    ListBox1.Clear
    [COLOR=#ff0000]For Each Clls In .Offset(1).Resize(, 1).SpecialCells(12)
      ListBox1.AddItem (Clls)
      ListBox1.List(i, 1) = Clls(, 2)
      ListBox1.List(i, 2) = Clls(, 3)
      i = i + 1
    Next[/COLOR]
    .AutoFilter
    .Value = Temp
  End With
  Application.ScreenUpdating = True
End Sub
Phần bôi màu đỏ ấy mình chẳng hiểu chút nào. Gúp mình hiểu nốt chỗ đó????
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
maytinhvp01 đã viết:
Chào các bạn! Mình đang tìm hiểu về phần tìm kiếm dữ liệu trong listbox, lên diễn đàn copy được một code cũng khá hay nhưng mình không hiểu đôi dòng code trong đó, ai biết giúp mình ý nghĩa hoạt đọng của nó được không?
Mã: 
Private Sub TextBox1_Change()
  Dim Clls As Range, Temp As Variant, i As Long
  Application.ScreenUpdating = False
  ListBox1.RowSource = ""
  If Len(Trim(TextBox1.Value)) = 0 Then Exit Sub
  With Sheet1.Range(Sheet1.[A1], Sheet1.[C65536].End(xlUp))
    Temp = .Value
    .Sort .Cells(2, 2), 1, Header:=xlGuess
    .AutoFilter 2, TextBox1.Value & "*"
    ListBox1.Clear
    [COLOR=#ff0000]For Each Clls In .Offset(1).Resize(, 1).SpecialCells(12)
      ListBox1.AddItem (Clls)
      ListBox1.List(i, 1) = Clls(, 2)
      ListBox1.List(i, 2) = Clls(, 3)
      i = i + 1
    Next[/COLOR]
    .AutoFilter
    .Value = Temp
  End With
  Application.ScreenUpdating = True
End Sub
Phần bôi màu đỏ ấy mình chẳng hiểu chút nào. Gúp mình hiểu nốt chỗ đó????
Nhấp chuột vào đây để mở rộng...

Thì vòng lập duyệt qua các cell không ẩn thôi (SpecialCells(12) )
Mà sao bạn không cho file lên nhỉ? Vì mình tin rằng có thể cải tiến code này 1 cách tốt hơn (vòng lập duyệt qua các cell sẽ không nhanh đâu)
 
Upvote 0
ndu96081631 đã viết:
Thì vòng lập duyệt qua các cell không ẩn thôi (SpecialCells(12) )
Mà sao bạn không cho file lên nhỉ? Vì mình tin rằng có thể cải tiến code này 1 cách tốt hơn (vòng lập duyệt qua các cell sẽ không nhanh đâu)
Nhấp chuột vào đây để mở rộng...

Anh nói thế em đã tìm hiểu thêm vè specialcells và đã hiểu nó chạy vòng lap qua tất cả các ô không ẩn sau khi filter
nhưng còn chỗ
Mã: 
[/COLOR][COLOR=#ff0000]ListBox1.AddItem (Clls)
      ListBox1.List(i, 1) = Clls(, 2)
      ListBox1.List(i, 2) = Clls(, 3)
      i = i + 1[/COLOR][COLOR=#ff0000]
anh giải thích thêm cho em cơ chế hoạt động chỗ này với ạh. em dọc và thử mãi mà vẫn chưa hiểu ạh??
 
Upvote 0
maytinhvp01 đã viết:
Anh nói thế em đã tìm hiểu thêm vè specialcells và đã hiểu nó chạy vòng lap qua tất cả các ô không ẩn sau khi filter
nhưng còn chỗ
Mã: 
[COLOR=#ff0000]ListBox1.AddItem (Clls)
      ListBox1.List(i, 1) = Clls(, 2)
      ListBox1.List(i, 2) = Clls(, 3)
      i = i + 1[/COLOR]
anh giải thích thêm cho em cơ chế hoạt động chỗ này với ạh. em dọc và thử mãi mà vẫn chưa hiểu ạh??
Nhấp chuột vào đây để mở rộng...
Chỗ màu đỏ đó có thể hiểu là: Thêm 1 Item cho ListBox1, ListBox này đã thiết lập trước đó có 3 cột, thì cột đầu chính là giá trị của ô Cll, cột thứ 2 và thứ 3 là giá trị của 2 ô ngay bên phải ô Cll. Đồng thời tăng biến đếm i lên 1 đơn vị để biết rằng số Item của ListBox1 đã được tăng lên.
 
Upvote 0
nghiaphuc đã viết:
Chỗ màu đỏ đó có thể hiểu là: Thêm 1 Item cho ListBox1, ListBox này đã thiết lập trước đó có 3 cột, thì cột đầu chính là giá trị của ô Cll, cột thứ 2 và thứ 3 là giá trị của 2 ô ngay bên phải ô Cll. Đồng thời tăng biến đếm i lên 1 đơn vị để biết rằng số Item của ListBox1 đã được tăng lên.
Nhấp chuột vào đây để mở rộng...
Mã: 
[COLOR=#000000]ListBox1.AddItem (Clls)
      ListBox1.List(i, 1)[/COLOR][COLOR=#ff0000] = Clls(, 2)
     [/COLOR][COLOR=#000000] ListBox1.List(i, 2[/COLOR][COLOR=#ff0000]) = Clls(, 3)
     [/COLOR][COLOR=#000000] i = i + 1[/COLOR][COLOR=#ff0000][/COLOR]
vậy cách ghi:
Clls(, 2)
Clls(, 3)
phải không ban??
ý nghĩa là chỉ địa chỉ ô cell "Clls" cùng hàng và có cột làn lượt là cột 2 và 3 phải không ban????
"vì hàng của ô CLLs ở đây mình không xác định" mình hiểu đúng không ạ???
 
Upvote 0
nghiaphuc đã viết:
Chỗ màu đỏ đó có thể hiểu là: Thêm 1 Item cho ListBox1, ListBox này đã thiết lập trước đó có 3 cột, thì cột đầu chính là giá trị của ô Cll, cột thứ 2 và thứ 3 là giá trị của 2 ô ngay bên phải ô Cll. Đồng thời tăng biến đếm i lên 1 đơn vị để biết rằng số Item của ListBox1 đã được tăng lên.
Nhấp chuột vào đây để mở rộng...
Mã: 
[COLOR=#000000]ListBox1.AddItem (Clls)
      ListBox1.List(i, 1)[/COLOR][COLOR=#ff0000] = Clls(, 2)
     [/COLOR][COLOR=#000000] ListBox1.List(i, 2[/COLOR][COLOR=#ff0000]) = Clls(, 3)
     [/COLOR][COLOR=#000000] i = i + 1[/COLOR]
vậy cách ghi:
Clls(, 2)
Clls(, 3)
phải không ban??
ý nghĩa là chỉ địa chỉ ô cell "Clls" cùng hàng và có cột làn lượt là cột 2 và 3 phải không ban????
"vì hàng của ô CLLs ở đây mình không xác định" mình hiểu đúng không ạ???
 
Upvote 0
nghiaphuc đã viết:
Chỗ màu đỏ đó có thể hiểu là: Thêm 1 Item cho ListBox1, ListBox này đã thiết lập trước đó có 3 cột, thì cột đầu chính là giá trị của ô Cll, cột thứ 2 và thứ 3 là giá trị của 2 ô ngay bên phải ô Cll. Đồng thời tăng biến đếm i lên 1 đơn vị để biết rằng số Item của ListBox1 đã được tăng lên.
Nhấp chuột vào đây để mở rộng...
Mã: 
[COLOR=#000000]ListBox1.AddItem (Clls)
      ListBox1.List(i, 1)[/COLOR][COLOR=#ff0000] = Clls(, 2)
     [/COLOR][COLOR=#000000] ListBox1.List(i, 2[/COLOR][COLOR=#ff0000]) = Clls(, 3)
     [/COLOR][COLOR=#000000] i = i + 1[/COLOR]
vậy cách ghi:
Clls(, 2)
Clls(, 3)
ý nghĩa là chỉ địa chỉ ô cell cùng hàng vơi "CLLs" và có cột làn lượt là cột 2 và 3 phải không ban????
"vì hàng của ô CLLs ở đây mình không xác định" mình hiểu đúng không ạ???
 
Upvote 0
maytinhvp01 đã viết:
Mã: 
[COLOR=#000000]ListBox1.AddItem (Clls)
      ListBox1.List(i, 1)[/COLOR][COLOR=#ff0000] = Clls(, 2)
     [/COLOR][COLOR=#000000] ListBox1.List(i, 2[/COLOR][COLOR=#ff0000]) = Clls(, 3)
     [/COLOR][COLOR=#000000] i = i + 1[/COLOR]
vậy cách ghi:
Clls(, 2)
Clls(, 3)
ý nghĩa là chỉ địa chỉ ô cell cùng hàng vơi "CLLs" và có cột làn lượt là cột 2 và 3 phải không ban????
"vì hàng của ô CLLs ở đây mình không xác định" mình hiểu đúng không ạ???
Nhấp chuột vào đây để mở rộng...

Thì bạn thí nghiệm đi
Thử đoạn code Range("A1")(, 2).Select xem nó sẽ Select cái gì ---> Từ đó mà suy ngẫm
 
Upvote 0
ndu96081631 đã viết:
Thì bạn thí nghiệm đi
Thử đoạn code Range("A1")(, 2).Select xem nó sẽ Select cái gì ---> Từ đó mà suy ngẫm
Nhấp chuột vào đây để mở rộng...

Vâng em đã hiểu rùi ạh. Với cell đang sét khi viết thêm .....(,x) thì nó sẽ chọn cell có cùng hàng và tịnh tiến số cột tính từ cột đang sét đúng bằng x cột nữa ạ. vậy thì kiểu ghi như thế này gần gống với lệnh offset phải không ạ?khác là ở chỗ " offset tính từ ô kế tiếp, còn cách này từ ô đang sét"
Ví dụ:
Cell đang sét là cells(3,3) nếu ghi cells(3,3).offset(3,6) >>>>cells(6,9)
------------------------------------------ cells(3,3)(3,6)>>>>>>>>>cells(5,8)
EM HIỂU THẾ CÓ ĐÚNG KHÔNG Ạ????
 
Upvote 0
maytinhvp01 đã viết:
vậy thì kiểu ghi như thế này gần gống với lệnh offset phải không ạ?khác là ở chỗ " offset tính từ ô kế tiếp, còn cách này từ ô đang sét"
Ví dụ:
Cell đang sét là cells(3,3) nếu ghi cells(3,3).offset(3,6) >>>>cells(6,9)
------------------------------------------ cells(3,3)(3,6)>>>>>>>>>cells(5,8)
EM HIỂU THẾ CÓ ĐÚNG KHÔNG Ạ????
Nhấp chuột vào đây để mở rộng...
Còn khác 1 chổ mà ít ai để ý: Offset có tác dụng hơi khác khi gặp MergeCell
Ví dụ: Range("A1").Offset(,1) lý ra sẽ là cell B1 Nhưng nếu A1:B1 bị merge lại với nhau thi Range("A1").Offset(,1) sẽ là cell C1
Vậy sự di chuyển của Offset gần giống như cách mà ta di chuyển cell bằng phím mũi tên ấy
-------------
Từ phân tích trên: Với bảng tính có MergeCell, hãy cẩn thận khi dùng Offset (coi chừng trật lất)
 
Upvote 0
ndu96081631 đã viết:
Còn khác 1 chổ mà ít ai để ý: Offset có tác dụng hơi khác khi gặp MergeCell
Ví dụ: Range("A1").Offset(,1) lý ra sẽ là cell B1 Nhưng nếu A1:B1 bị merge lại với nhau thi Range("A1").Offset(,1) sẽ là cell C1
Vậy sự di chuyển của Offset gần giống như cách mà ta di chuyển cell bằng phím mũi tên ấy
-------------
Từ phân tích trên: Với bảng tính có MergeCell, hãy cẩn thận khi dùng Offset (coi chừng trật lất)
Nhấp chuột vào đây để mở rộng...

Quá sâu sắc đúng là hỏi xong thấy thoải mái hẳn cái đầu chứ không thấy khó chịu!!!
 
Upvote 0
ndu96081631 đã viết:
Còn khác 1 chổ mà ít ai để ý: Offset có tác dụng hơi khác khi gặp MergeCell
Ví dụ: Range("A1").Offset(,1) lý ra sẽ là cell B1 Nhưng nếu A1:B1 bị merge lại với nhau thi Range("A1").Offset(,1) sẽ là cell C1
Vậy sự di chuyển của Offset gần giống như cách mà ta di chuyển cell bằng phím mũi tên ấy
-------------
Từ phân tích trên: Với bảng tính có MergeCell, hãy cẩn thận khi dùng Offset (coi chừng trật lất)
Nhấp chuột vào đây để mở rộng...

Em lại gặp khó khăn khi áp dụng vào thực tế :
Code này dành cho listbox có 3 cột
Mã: 
Private Sub TextBox1_Change()
    Dim Clls As Range, Temp As Variant, i As Long
    Application.ScreenUpdating = False
    ListBox1.RowSource = ""
    If Len(Trim(TextBox1.Value)) = 0 Then Exit Sub
    With Sheet1.Range(Sheet1.[A6], Sheet1.[C65536].End(xlUp))
        Temp = .Value
        .Sort .Cells(7, 3), 1, Header:=xlGuess
        .AutoFilter 3, TextBox1.Value & "*"
        ListBox1.Clear
        For Each Clls In .Offset(1).Resize(, 1).SpecialCells(12)
            ListBox1.AddItem (Clls)
            ListBox1.List(i, 1) = Clls(, 2)
            ListBox1.List(i, 2) = Clls(, 3)   
             i = i + 1
        Next
        .AutoFilter
        .Value = Temp
    End With
    Application.ScreenUpdating = True
End Sub
Từ code này em muốn làm cho listbox có 29 cột
Mã: 
Private Sub TextBox1_Change()
    Dim Clls As Range, Temp As Variant, i As Long, j As Long
    Application.ScreenUpdating = False
    ListBox1.RowSource = ""
    If Len(Trim(TextBox1.Value)) = 0 Then Exit Sub
    With Sheet1.Range(Sheet1.[A6], Sheet1.[C65536].End(xlUp))
        Temp = .Value
        .Sort .Cells(7, 3), 1, Header:=xlGuess
        .AutoFilter 3, TextBox1.Value & "*"
        ListBox1.Clear
        For Each Clls In .Offset(1).Resize(, 1).SpecialCells(12)
            ListBox1.AddItem (Clls)
                For j = 1 To 28
                   [COLOR=#ff0000] ListBox1.List(i, j) = Clls(, j + 1)[/COLOR]
                Next
        i = i + 1
        Next
        .AutoFilter
        .Value = Temp
    End With
    Application.ScreenUpdating = True
End Sub
Nhưng khi chạy luôn báo lỗi dòng đánh dấu chữ đỏ. Cho em hỏi vì sao ạ???
em gủi file lên đây ạ!
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
maytinhvp01 đã viết:
Em lại gặp khó khăn khi áp dụng vào thực tế :
Code này dành cho listbox có 3 cột
Từ code này em muốn làm cho listbox có 29 cột
Nhưng khi chạy luôn báo lỗi dòng đánh dấu chữ đỏ. Cho em hỏi vì sao ạ???
em gủi file lên đây ạ!
Nhấp chuột vào đây để mở rộng...

Hinh như không thể Add quá 10 cột thì phải ---> Tìm cách khác thôi
 
Upvote 0
ndu96081631 đã viết:
Hinh như không thể Add quá 10 cột thì phải ---> Tìm cách khác thôi
Nhấp chuột vào đây để mở rộng...
Vâng ạ e thủ cũng thấy vậy! Vậy giờ em định làm thế này:
+Dùng 1 sheet phụ luu giá trị sau khi đã lọc từ bảng chính sau đó lấy rowsour của listbox là bảng phụ
+khi tren textbox ="" hay thoat form thì thiết lập lại rowsour của listbox về bảng cũ vậy được không a?
+Hay anh bày em cánh khác nhanh hơn và giải quết được nhu cầu của em với ạ????
 
Upvote 0
maytinhvp01 đã viết:
Vâng ạ e thủ cũng thấy vậy! Vậy giờ em định làm thế này:
+Dùng 1 sheet phụ luu giá trị sau khi đã lọc từ bảng chính sau đó lấy rowsour của listbox là bảng phụ
+khi tren textbox ="" hay thoat form thì thiết lập lại rowsour của listbox về bảng cũ vậy được không a?
+Hay anh bày em cánh khác nhanh hơn và giải quết được nhu cầu của em với ạ????
Nhấp chuột vào đây để mở rộng...

Thật ra nếu tôi làm bài này thì "đồ chơi" đã có sẵn cả rồi (Hàm Filter2DArray).. cứ thế ráp vào xài thôi
Tuy nhiên nếu bạn chọn cách đơn giản thì bạn nên dùng Advanced Filter. Cách làm:
- Khi gõ gì đó trên TextBox thì lập tức chuổi này sẽ được điền vào cell nào đó trên bảng tính và đây chính là vùng điều kiện cho AF
- Advanced Filter sẽ lọc theo điều kiện rồi đặt kết quả vào 1 nơi nào đó
- Lấy kết quả thu được làm RowSource mới cho ListBox
Đại khái vậy
 
Upvote 0
ndu96081631 đã viết:
Thật ra nếu tôi làm bài này thì "đồ chơi" đã có sẵn cả rồi (Hàm Filter2DArray).. cứ thế ráp vào xài thôi
Tuy nhiên nếu bạn chọn cách đơn giản thì bạn nên dùng Advanced Filter. Cách làm:
- Khi gõ gì đó trên TextBox thì lập tức chuổi này sẽ được điền vào cell nào đó trên bảng tính và đây chính là vùng điều kiện cho AF
- Advanced Filter sẽ lọc theo điều kiện rồi đặt kết quả vào 1 nơi nào đó
- Lấy kết quả thu được làm RowSource mới cho ListBox
Đại khái vậy
Nhấp chuột vào đây để mở rộng...
Vâng ạ nếu cái add của listbox không cho quá 10 lần thì như em nói em sẽ dùng 1 sheet phụ để luu chuyển du liêu dua vào thuộc tính rowsource của listbox. Đây là cái em làm. nhưng trên file thực của em dữ liệu nhiều chạy hoi chậm anh có cánh nào giải quyết tốc độ cho em học hỏi với
 

File đính kèm

Upvote 0
Đến giờ mà bạn vẫn giữ cách sử lý trên Sheet nên chậm mà không hoạt là phải.
Bạn thử cách này xem sao chứ mình thấy ngon như chuối:

1/Thêm 1 Module để thêm 1 hàm UDF Filter2DArray làm nhiệm vụ lọc dữ liệu, đây là hàm Ndu viết đã khá lâu rồi, hoàn toàn sử lý trên mảng tốc độ khá nhanh.

Mã: 
Function Filter2DArray(ByVal sArray, ByVal ColIndex As Long, ByVal FindStr As String, ByVal HasTitle As Boolean)
  Dim TmpArr, i As Long, j As Long, Arr, Dic, TmpStr, Tmp, Chk As Boolean, TmpVal As Double
  On Error Resume Next
  Set Dic = CreateObject("Scripting.Dictionary")
  TmpArr = sArray
  ColIndex = ColIndex + LBound(TmpArr, 2) - 1
  Chk = (InStr("><=", Left(FindStr, 1)) > 0)
  For i = LBound(TmpArr, 1) - HasTitle To UBound(TmpArr, 1)
    If Chk And FindStr <> "" Then
      TmpVal = CDbl(TmpArr(i, ColIndex))
      If Evaluate(TmpVal & FindStr) Then Dic.Add i, ""
    Else
      If UCase(TmpArr(i, ColIndex)) Like UCase(FindStr) Then Dic.Add i, ""
    End If
  Next
  If Dic.Count > 0 Then
    Tmp = Dic.Keys
    ReDim Arr(LBound(TmpArr, 1) To UBound(Tmp) + LBound(TmpArr, 1) - HasTitle, LBound(TmpArr, 2) To UBound(TmpArr, 2))
    For i = LBound(TmpArr, 1) - HasTitle To UBound(Tmp) + LBound(TmpArr, 1) - HasTitle
      For j = LBound(TmpArr, 2) To UBound(TmpArr, 2)
        Arr(i, j) = TmpArr(Tmp(i - LBound(TmpArr, 1) + HasTitle), j)
      Next
    Next
    If HasTitle Then
      For j = LBound(TmpArr, 2) To UBound(TmpArr, 2)
        Arr(LBound(TmpArr, 1), j) = TmpArr(LBound(TmpArr, 1), j)
      Next
    End If
  End If
  Filter2DArray = Arr
End Function

2/Bạn xóa hết các thuộc tính của Listbox mà bạn thiết lập trong Properties đi để chủ động sử lý bằng Code, như vậy sau này điều chỉnh nhanh hơn nhiều.
Bạn bỏ phương thức Add vì nó hạn chế cột Add mà thay bằng phương thức List sẽ load được hết số cột theo yêu cầu.
3/Thêm 1 label để làm tiêu đề cột (Vì mình thấy bạn có vẻ thích cái này)

Toàn bộ Code của Form như sau

Mã: 
Option Explicit
'-------------------------------------------------------
Private Sub TextBox1_Change()
LoadDT
End Sub
'-------------------------------------------------------
Sub LoadDT()
Dim Dk As String, Arr(), Tm
On Error GoTo Thoat
Dk = UCase(Trim(Me.TextBox1)) & "*"
Tm = Sheet1.Range("A7:AB" & Sheet1.[A65536].End(3).Row)
Arr = Filter2DArray(Tm, 3, UCase(Trim(Me.TextBox1)) & "*", False)
If Me.ListBox1.ListCount > 0 Then Me.ListBox1.Clear
Me.ListBox1.List() = Arr
Exit Sub
Thoat:
If Me.ListBox1.ListCount > 0 Then Me.ListBox1.Clear
End Sub
'-----------------------------------------------------------
Private Sub UserForm_Initialize()
Dim Lg(), Lg1(), Td, i
Lg = Array(24.95, 130, 130, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, _
24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95)
Lg1 = Array(11, 50, 50, 9, 8, 9, 9, 8, 9, 9, 8, 9, 8, 8, 8, 8, 7, 8, 7, 8, 8, 8, 7, 8, 8, 8, 8, 8, 8)
Td = "|"
For i = 1 To 29
Td = Td & Left(Sheet1.Cells(6, i) & Space(130), Lg1(i - 1)) & "|"
Next
Me.Label1.Caption = Td
Me.ListBox1.ColumnCount = UBound(Lg) + 1
Me.ListBox1.ColumnWidths = Join(Lg, ";")
LoadDT
End Sub

Giờ bạn gõ trên Textbox mã cần tìm xem sao.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
sealand đã viết:
Đến giờ mà bạn vẫn giữ cách sử lý trên Sheet nên chậm mà không hoạt là phải.
Bạn thử cách này xem sao chứ mình thấy ngon như chuối:

1/Thêm 1 Module để thêm 1 hàm UDF Filter2DArray làm nhiệm vụ lọc dữ liệu, đây là hàm Ndu viết đã khá lâu rồi, hoàn toàn sử lý trên mảng tốc độ khá nhanh.

Mã: 
Function Filter2DArray(ByVal sArray, ByVal ColIndex As Long, ByVal FindStr As String, ByVal HasTitle As Boolean)
  Dim TmpArr, i As Long, j As Long, Arr, Dic, TmpStr, Tmp, Chk As Boolean, TmpVal As Double
  On Error Resume Next
  Set Dic = CreateObject("Scripting.Dictionary")
  TmpArr = sArray
  ColIndex = ColIndex + LBound(TmpArr, 2) - 1
  Chk = (InStr("><=", Left(FindStr, 1)) > 0)
  For i = LBound(TmpArr, 1) - HasTitle To UBound(TmpArr, 1)
    If Chk And FindStr <> "" Then
      TmpVal = CDbl(TmpArr(i, ColIndex))
      If Evaluate(TmpVal & FindStr) Then Dic.Add i, ""
    Else
      If UCase(TmpArr(i, ColIndex)) Like UCase(FindStr) Then Dic.Add i, ""
    End If
  Next
  If Dic.Count > 0 Then
    Tmp = Dic.Keys
    ReDim Arr(LBound(TmpArr, 1) To UBound(Tmp) + LBound(TmpArr, 1) - HasTitle, LBound(TmpArr, 2) To UBound(TmpArr, 2))
    For i = LBound(TmpArr, 1) - HasTitle To UBound(Tmp) + LBound(TmpArr, 1) - HasTitle
      For j = LBound(TmpArr, 2) To UBound(TmpArr, 2)
        Arr(i, j) = TmpArr(Tmp(i - LBound(TmpArr, 1) + HasTitle), j)
      Next
    Next
    If HasTitle Then
      For j = LBound(TmpArr, 2) To UBound(TmpArr, 2)
        Arr(LBound(TmpArr, 1), j) = TmpArr(LBound(TmpArr, 1), j)
      Next
    End If
  End If
  Filter2DArray = Arr
End Function

2/Bạn xóa hết các thuộc tính của Listbox mà bạn thiết lập trong Properties đi để chủ động sử lý bằng Code, như vậy sau này điều chỉnh nhanh hơn nhiều.
Bạn bỏ phương thức Add vì nó hạn chế cột Add mà thay bằng phương thức List sẽ load được hết số cột theo yêu cầu.
3/Thêm 1 label để làm tiêu đề cột (Vì mình thấy bạn có vẻ thích cái này)

Toàn bộ Code của Form như sau

Mã: 
Option Explicit
'-------------------------------------------------------
Private Sub TextBox1_Change()
LoadDT
End Sub
'-------------------------------------------------------
Sub LoadDT()
Dim Dk As String, Arr(), Tm
On Error GoTo Thoat
Dk = UCase(Trim(Me.TextBox1)) & "*"
Tm = Sheet1.Range("A7:AB" & Sheet1.[A65536].End(3).Row)
Arr = Filter2DArray(Tm, 3, UCase(Trim(Me.TextBox1)) & "*", False)
Sheet3.[A1].Resize(UBound(Arr, 1), UBound(Arr, 2)) = Arr
If Me.ListBox1.ListCount > 0 Then Me.ListBox1.Clear
Me.ListBox1.List() = Arr
Exit Sub
Thoat:
If Me.ListBox1.ListCount > 0 Then Me.ListBox1.Clear
End Sub
'-----------------------------------------------------------
Private Sub UserForm_Initialize()
Dim Lg(), Lg1(), Td, i
Lg = Array(24.95, 130, 130, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, _
24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95)
Lg1 = Array(11, 50, 50, 9, 8, 9, 9, 8, 9, 9, 8, 9, 8, 8, 8, 8, 7, 8, 7, 8, 8, 8, 7, 8, 8, 8, 8, 8, 8)
Td = "|"
For i = 1 To 29
Td = Td & Left(Sheet1.Cells(6, i) & Space(130), Lg1(i - 1)) & "|"
Next
Me.Label1.Caption = Td
Me.ListBox1.ColumnCount = UBound(Lg) + 1
Me.ListBox1.ColumnWidths = Join(Lg, ";")
LoadDT
End Sub

Giờ bạn gõ trên Textbox mã cần tìm xem sao.
Nhấp chuột vào đây để mở rộng...

Đúng là tốc độ quá khủng.Và cái tiêu đề cũng rất là ngon. Mình sẽ hỏi tiếp khi học mà không hiểu nhé.Thank!!!
 
Upvote 0
Bạn xoá giúp dòng sau trong Sub LoadDT, mình Test nhưng dọn chưa hết

Sheet3.[A1].Resize(UBound(Arr, 1), UBound(Arr, 2)) = Arr
 
Upvote 0
maytinhvp01 đã viết:
Đúng là tốc độ quá khủng.Và cái tiêu đề cũng rất là ngon. Mình sẽ hỏi tiếp khi học mà không hiểu nhé.Thank!!!
Nhấp chuột vào đây để mở rộng...

Hỏi ngoài lề chút: Xem file của bạn, thấy TÊN MÁY, MÃ MÁY sao nó giống máy móc của công ty mình đang làm thể nhỉ (CSI)
???
 
Upvote 0
ndu96081631 đã viết:
Hỏi ngoài lề chút: Xem file của bạn, thấy TÊN MÁY, MÃ MÁY sao nó giống máy móc của công ty mình đang làm thể nhỉ (CSI)
???
Nhấp chuột vào đây để mở rộng...

Vâng ạ không dấu gì anh em có nói là coppy được code trên diễn đàn. cụ thể là trên http://www.giaiphapexcel.com/forum/showthread.php?24123-Tạo-hiệu-ứng-cho-UserForm
mượn đó để học hỏi luôn ạh. bài của ANH TUẤN đấy thầy ạ!
giờ em đang muốn tìm hiểu về ADODB để hiểu được code lấy dữ liệu từ file đóng sang file hiện hành" Em phải hiểu nó em mới dám dùng thầy ạ, chứ coppy y trang mà chảng hiểu thấy khó chịu lắm ạ, Vậy tiện đấy thầy cho em đôi trang hay tài liệu về ADODB liên quan nhiều tới VBA và excel được không ạ?"
 
Lần chỉnh sửa cuối:
Upvote 0
sealand đã viết:
Private Sub UserForm_Initialize()
Dim Lg(), Lg1(), Td, i
Lg = Array(24.95, 130, 130, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, _
24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95)
Lg1 = Array(11, 50, 50, 9, 8, 9, 9, 8, 9, 9, 8, 9, 8, 8, 8, 8, 7, 8, 7, 8, 8, 8, 7, 8, 8, 8, 8, 8, 8)
Td = "|"
For i = 1 To 29
Td = Td & Left(Sheet1.Cells(6, i) & Space(130), Lg1(i - 1)) & "|"
Next
Me.Label1.Caption = Td
Me.ListBox1.ColumnCount = UBound(Lg) + 1
Me.ListBox1.ColumnWidths = Join(Lg, ";")
LoadDT
End Sub
"
Nhấp chuột vào đây để mở rộng...

Anh ơi trong UserForm của em đã có code
Private Sub UserForm_Initialize()

Application.WindowState = xlMaximized
Me.Top = 0: Me.Left = 0
Me.Width = Application.Width
Me.Height = Application.Height

With ShockwaveFlash1
.Top = 6
.Left = 624
.Width = 63
.Height = 63
End With

MyControls = Array(txtSoTT, cbxCaSX, txtNgayDuc, cbxMayDuc, cbxMaSanPham, _
cbxKhuon, txtGioCheck, cbxNguoiCheck, txtKetQuaOK, txtCavity, _
cbxLoiNG, cbxNguoiGiaiQuyet, txtGioKT, txtKiemTraHop, txtThaoTacOP, _
cbxNguoiKT, txtGioCapNhua, txtGioKiemTraCN, txtNhaCungCap, txtNhaSX, _
cbxTenNhua, txtLaiNhua, cbxMaMau, _
txtGHICHU)

Dim iRow As Long
With Sheets("Nhap lieu")
iRow = .Range("A65536").End(xlUp).Row
.Range("A5:X" & iRow).Name = "ListBoxNhapLieu"
ListBox1.RowSource = "ListBoxNhapLieu"
ListBox1.ListIndex = ListBox1.ListCount - 1
End With
End Sub
Em add code trên vào thì bị lỗi giờ em phải chỉnh thế nào để không bị lỗi code trong UserForm
 
Upvote 0
sealand đã viết:
Đến giờ mà bạn vẫn giữ cách sử lý trên Sheet nên chậm mà không hoạt là phải.
Bạn thử cách này xem sao chứ mình thấy ngon như chuối:

1/Thêm 1 Module để thêm 1 hàm UDF Filter2DArray làm nhiệm vụ lọc dữ liệu, đây là hàm Ndu viết đã khá lâu rồi, hoàn toàn sử lý trên mảng tốc độ khá nhanh.

Mã: 
Function Filter2DArray(ByVal sArray, ByVal ColIndex As Long, ByVal FindStr As String, ByVal HasTitle As Boolean)
  Dim TmpArr, i As Long, j As Long, Arr, Dic, TmpStr, Tmp, Chk As Boolean, TmpVal As Double
  On Error Resume Next
  Set Dic = CreateObject("Scripting.Dictionary")
  TmpArr = sArray
  ColIndex = ColIndex + LBound(TmpArr, 2) - 1
  Chk = (InStr("><=", Left(FindStr, 1)) > 0)
  For i = LBound(TmpArr, 1) - HasTitle To UBound(TmpArr, 1)
    If Chk And FindStr <> "" Then
      TmpVal = CDbl(TmpArr(i, ColIndex))
      If Evaluate(TmpVal & FindStr) Then Dic.Add i, ""
    Else
      If UCase(TmpArr(i, ColIndex)) Like UCase(FindStr) Then Dic.Add i, ""
    End If
  Next
  If Dic.Count > 0 Then
    Tmp = Dic.Keys
    ReDim Arr(LBound(TmpArr, 1) To UBound(Tmp) + LBound(TmpArr, 1) - HasTitle, LBound(TmpArr, 2) To UBound(TmpArr, 2))
    For i = LBound(TmpArr, 1) - HasTitle To UBound(Tmp) + LBound(TmpArr, 1) - HasTitle
      For j = LBound(TmpArr, 2) To UBound(TmpArr, 2)
        Arr(i, j) = TmpArr(Tmp(i - LBound(TmpArr, 1) + HasTitle), j)
      Next
    Next
    If HasTitle Then
      For j = LBound(TmpArr, 2) To UBound(TmpArr, 2)
        Arr(LBound(TmpArr, 1), j) = TmpArr(LBound(TmpArr, 1), j)
      Next
    End If
  End If
  Filter2DArray = Arr
End Function

2/Bạn xóa hết các thuộc tính của Listbox mà bạn thiết lập trong Properties đi để chủ động sử lý bằng Code, như vậy sau này điều chỉnh nhanh hơn nhiều.
Bạn bỏ phương thức Add vì nó hạn chế cột Add mà thay bằng phương thức List sẽ load được hết số cột theo yêu cầu.
3/Thêm 1 label để làm tiêu đề cột (Vì mình thấy bạn có vẻ thích cái này)

Toàn bộ Code của Form như sau

Mã: 
Option Explicit
'-------------------------------------------------------
Private Sub TextBox1_Change()
LoadDT
End Sub
'-------------------------------------------------------
Sub LoadDT()
Dim Dk As String, Arr(), Tm
On Error GoTo Thoat
Dk = UCase(Trim(Me.TextBox1)) & "*"
Tm = Sheet1.Range("A7:AB" & Sheet1.[A65536].End(3).Row)
Arr = Filter2DArray(Tm, 3, UCase(Trim(Me.TextBox1)) & "*", False)
If Me.ListBox1.ListCount > 0 Then Me.ListBox1.Clear
Me.ListBox1.List() = Arr
Exit Sub
Thoat:
If Me.ListBox1.ListCount > 0 Then Me.ListBox1.Clear
End Sub
'-----------------------------------------------------------
Private Sub UserForm_Initialize()
Dim Lg(), Lg1(), Td, i
Lg = Array(24.95, 130, 130, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, _
24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95, 24.95)
Lg1 = Array(11, 50, 50, 9, 8, 9, 9, 8, 9, 9, 8, 9, 8, 8, 8, 8, 7, 8, 7, 8, 8, 8, 7, 8, 8, 8, 8, 8, 8)
Td = "|"
For i = 1 To 29
Td = Td & Left(Sheet1.Cells(6, i) & Space(130), Lg1(i - 1)) & "|"
Next
Me.Label1.Caption = Td
Me.ListBox1.ColumnCount = UBound(Lg) + 1
Me.ListBox1.ColumnWidths = Join(Lg, ";")
LoadDT
End Sub

Giờ bạn gõ trên Textbox mã cần tìm xem sao.
Nhấp chuột vào đây để mở rộng...
Chào Anh ! E có file muốn tìm kiếm tương tự như file anh làm nhưng chưa biết phải làm thế nào, Anh vui lòng bớt chút thời gian qua link e đã gửi lên GPE nhờ giúp đỡ nhưng chưa được trả lời viết giúp e đoạn code tương tự, Mong nhận được sự giúp đỡ của a, Xin chân thành cám ơn anh, phiền anh qua link này giúp e ạ: http://www.giaiphapexcel.com/forum/...le-đính-kèm-về-tìm-kiếm-trên-form-qua-textbox
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

Bài viết mới nhất

B
Chuyển số tiền thành chữ
Trả lời
0
Đọc
11
bongngongo
B
B
Sau 1 tháng Mã Lại reset về 1 trở lên (1 người xem)
Trả lời
19
Đọc
202
HieuCD
H
H
Đánh số thứ thự phiếu thu chi
Trả lời
14
Đọc
221
LOGANWover
L
H
  • Question Question
Xin giúp đỡ về tạo hàm excel với C# và excel-dna
Trả lời
0
Đọc
49
hdcv.excel
H
N
  • Question Question
Cho em hỏi về mail merge bằng vba
Trả lời
5
Đọc
136
Hoàng Tuấn 868
H
T
Khóa cột cập nhật dữ liệu
Trả lời
0
Đọc
50
tnkhanhvy
T
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
3 4 5
Trả lời
411
Đọc
50K
ongke0711
ongke0711
H
Tìm kiếm thông tin chi tiết trên sheet tổng hợp
Trả lời
1
Đọc
66
LOGANWover
L
T
Xin hỏi về bảng lương
Trả lời
0
Đọc
68
tuandovn
T
Gà Công Nghệ
Tô màu họ và tên bị trùng từ 2 sheet khác nhau
Trả lời
6
Đọc
126
Gà Công Nghệ
Gà Công Nghệ
A
  • Question Question
Giải thích giúp mình code giải phóng bộ nhớ từ biến (1 người xem)
Trả lời
20
Đọc
9K
nguyendang95
N
Nguyenkhang2404
giúp đỡ lọc dữ liệu nâng cao (2 người xem)
Trả lời
22
Đọc
749
Phan Thế Hiệp
Phan Thế Hiệp
B
Dùng button trên forrm để gọi bàn phím ảo win 10(OSK)
Trả lời
5
Đọc
133
huhumalu
H
P
VẼ ĐƯỜNG TẦN SUẤT (DTS) TRÊN EXCEL
Trả lời
8
Đọc
212
ptm0412
ptm0412
P
GOAL SEEK NÂNG CAO TRONG EXCEL
    • Thích
Trả lời
4
Đọc
221
Hoale85
H
B
Gán Phím Tắt Gọi Form
Trả lời
7
Đọc
126
HeSanbi
HeSanbi
K
Điền giá trị ô thay vì địa chỉ ô (1 người xem)
Trả lời
2
Đọc
132
LOGANWover
L
G
Chia sẻ các bạn File vẽ kèo Zamil từ excel
    • Thích
    • Yêu thích
Trả lời
11
Đọc
933
trqt82
T
T
Xin trợ giúp cách lọc trùng về khoảng thời gian
Trả lời
10
Đọc
2K
Phan Thế Hiệp
Phan Thế Hiệp
L
Xin hàm trích xuất chuỗi trong ô
Trả lời
12
Đọc
235
LINH7979
L
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom