Giúp code lọc dữ liệu siêu tốc khoảng 10.000 dòng (2 người xem)

[minhtuan55]

Chào cả nhà GPE!
Em đang cần làm 1 đoạn code để lọc dữ liệu khoảng 10.000 dòng trở xuống ( code khi đánh vài ký tự liên quan trong Textbox thì Listbox sẽ hiện ra kết quả ( Trong Form)). Hiện em đang dùng code cũng ở trên diễn đàn
Nhưng nó xứ lý chỉ được 500 dòng là OK mà 10.000 dòng thì như rùa bò luôn. Mong các cao thủ giúp em. XIn chân thành cảm ơn !

Sub locnhapkhonewa()
 On Error Resume Next
Dim dl(), i As Long
dl = Sheets("khachhang").Range("K4:K5003").Value 'lay nguon hang hoa
THANHTOAN.ListBox1.Clear
For i = 1 To UBound(dl)
   If dl(i, 1) <> "" Then
      If TV(UCase(dl(i, 1))) Like "*" & TV(UCase(THANHTOAN.TextBox1.Value)) & "*" Then ' dieu kien loc Bo dau tieng viet Chu hoa chu thuong
         THANHTOAN.ListBox1.AddItem dl(i, 1)
      End If
   End If
Next
End Sub



Function TV(ByVal Text As String) As String ' bo dau tieng viet
  Dim CharCode, ResText As String, i As Long, tmp As String
  On Error Resume Next
  tmp = Text
  CharCode = Array(ChrW(7855), ChrW(7857), ChrW(7859), ChrW(7861), ChrW(7863), ChrW(7845), ChrW(7847), _
                   ChrW(7849), ChrW(7851), ChrW(7853), ChrW(225), ChrW(224), ChrW(7843), ChrW(227), ChrW(7841), _
                   ChrW(259), ChrW(226), ChrW(273), ChrW(7871), ChrW(7873), ChrW(7875), ChrW(7877), ChrW(7879), _
                   ChrW(233), ChrW(232), ChrW(7867), ChrW(7869), ChrW(7865), ChrW(234), ChrW(237), ChrW(236), _
                   ChrW(7881), ChrW(297), ChrW(7883), ChrW(7889), ChrW(7891), ChrW(7893), ChrW(7895), ChrW(7897), _
                   ChrW(7899), ChrW(7901), ChrW(7903), ChrW(7905), ChrW(7907), ChrW(243), ChrW(242), ChrW(7887), _
                   ChrW(245), ChrW(7885), ChrW(244), ChrW(417), ChrW(7913), ChrW(7915), ChrW(7917), ChrW(7919), _
                   ChrW(7921), ChrW(250), ChrW(249), ChrW(7911), ChrW(361), ChrW(7909), ChrW(432), ChrW(253), _
                   ChrW(7923), ChrW(7927), ChrW(7929), ChrW(7925))
  ResText = "aaaaaaaaaaaaaaaaadeeeeeeeeeeeiiiiiooooooooooooooooouuuuuuuuuuuyyyyy"
  For i = 0 To UBound(CharCode)
    tmp = Replace(tmp, CharCode(i), Mid(ResText, i + 1, 1))
    tmp = Replace(tmp, UCase(CharCode(i)), UCase(Mid(ResText, i + 1, 1)))
  Next
  TV = tmp
End Function



Private Sub TextBox1_Change()
locnhapkhonewa
End Sub

 

[mykoloda]

xem file

Cảm ơn bác nhiều.Bác cho hỏi Muốn hiển thị thêm 1 cột nữa trong listbox phải chỉnh sao bác.Em có thêm ColumnCount nhưng nó lại hiện các cột mà bác đã loại bỏ dấu

 

[HieuCD]

Cảm ơn bác nhiều.Bác cho hỏi Muốn hiển thị thêm 1 cột nữa trong listbox phải chỉnh sao bác.Em có thêm ColumnCount nhưng nó lại hiện các cột mà bác đã loại bỏ dấu

textbox1.list=darr là lệnh đưa dữ liệu vào, khai báo darr 7 cột và list 7 cột

 

[mykoloda]

textbox1.list=darr là lệnh đưa dữ liệu vào, khai báo darr 7 cột và list 7 cột

Bác có thể đưa code cần thay không ạ.Em làm nó hiển thị thêm cột nhưng không có dữ liệu cột mới thêm bác à

 

[HieuCD]

Bác có thể đưa code cần thay không ạ.Em làm nó hiển thị thêm cột nhưng không có dữ liệu cột mới thêm bác à

Dữ liệu chỉ có 6 cột, cột 7 bạn lấy ở đâu?

 

[mykoloda]

Dữ liệu chỉ có 6 cột, cột 7 bạn lấy ở đâu?

Em có thêm dữ liệu ở cột thứ 7 nhưng chỉ hiện khoảng trống không thấy dữ liệu đâu cả,Em có thay Redim darr(1 to k, 1 to 7) và listbox.columncount = 7

 

[HieuCD]

Em có thêm dữ liệu ở cột thứ 7 nhưng chỉ hiện khoảng trống không thấy dữ liệu đâu cả,Em có thay Redim darr(1 to k, 1 to 7) và listbox.columncount = 7

Vấn đề là phải có dữ liệu đưa vào cột 7 của dArr, file bạn gởi chỉ có 6 cột thôi

 

[mykoloda]

Vấn đề là phải có dữ liệu đưa vào cột 7 của dArr, file bạn gởi chỉ có 6 cột thôi

Đúng rùi nhưng em muốn hỏi để nhỡ sau này phát sinh thêm cột nữa.Thì không phải phiền tới bác ạ

 

[HieuCD]

Đúng rùi nhưng em muốn hỏi để nhỡ sau này phát sinh thêm cột nữa.Thì không phải phiền tới bác ạ

xem file

 

[mykoloda]

xem file

Cảm ơn bác nhiều...