Array & Listview tốc độ kinh hoàng ( 4s với 65500 dòng )!!!

Liên hệ QC
K

khoa140383

Thành viên hoạt động
Tham gia
2/10/09
Bài viết
101
Được thích
33
Chào cả nhà !!!

Sau một thời gian săn lùng trên mạng thì em tìm được code để nạp Array vào listview với tốc độ cực khủng. Nhưng bài sau đó em mò tiếp hàm Filter2D trên diễn đàn để áp dụng vào trường hợp này thì đang bị bó tay. Các bác xem dùm em nha. Em muốn hoàn thiện cái này để chuyển từ Listbox sang Listview.
Note : File này em muốn dùng Filter2D với cột 1 của Listview. Sau khi lọc thì sẽ xoá danh sách cũ và nạp ngược trở lại Listview các dòng thoả điều kiện.

Thanks all.
Have a nice day !!!
 

File đính kèm

  • arr & listview.xls
    44.5 KB · Đọc: 326
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Bạn thêm hàm vào và sửa chút xíu thôi:

Mã: 
Private Sub UserForm_Initialize()
Dim a(), r&, c&, rs&, cs&, i, ii, [COLOR=#ff0000][B]MyArr[/B][/COLOR]
i = Timer
With ListView1
' Do some common settings
.View = lvwReport
.Gridlines = True
.HideColumnHeaders = False

' Create the column headers
.ColumnHeaders.Add , , "COLUMN 1", 100
.ColumnHeaders.Add , , "COLUMN 2", 100
.ColumnHeaders.Add , , "COLUMN 3", 100

' Populate test range with 3 columns of data
With Range("A1:C65500")
[COLOR=#ff0000][B]MyArr = Filter2DArray(.Value, 1, "[", False)[/B][/COLOR]
'.Formula = "=COLUMN()& ""-""&ROW()"
[COLOR=#0000cd][B]a() = MyArr [/B][/COLOR]' <-- copy test data into array
End With

' Copy test data from a() to ListView1
rs = UBound(a, 1)
cs = UBound(a, 2)

For r = 1 To rs
    With .ListItems.Add(, , a(r, 1))

        For c = 2 To cs
            .SubItems(c - 1) = a(r, c)
        Next
    End With
Next

End With
ii = Timer
MsgBox (ii - i)
End Sub


Hàm Filter2DArray của Thầy ndu96081631:

PHP: 
Function Filter2DArray(ByVal sArray, ByVal ColIndex As Long, ByVal FindStr As String, ByVal HasTitle As Boolean)
    Dim TmpArr, Arr, Dic, TmpStr, Tmp
    Dim i As Long, j As Long, 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 Left(FindStr, 1) = "!" Then
                If Not (UCase(TmpArr(i, ColIndex)) Like UCase(Mid(FindStr, 2, Len(FindStr)))) Then Dic.Add i, ""
            Else
                If UCase(TmpArr(i, ColIndex)) Like UCase(FindStr) Then Dic.Add i, ""
            End If
        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
 
Lần chỉnh sửa cuối:
Upvote 0
Cám ơn minhthien321 rất nhiều. Nhưng sao mình gán vào sự kiện textbox change thì nó lại báo lỗi ngay cái dòng :


a() = MyArr ' <-- copy test data into array

Bạn xem giúp mình được không ? Dùng sự kiện textbox change ( hay afterupdate cũng được )

Thanks .
 
Upvote 0
khoa140383 đã viết:
Cám ơn minhthien321 rất nhiều. Nhưng sao mình gán vào sự kiện textbox change thì nó lại báo lỗi ngay cái dòng :


a() = MyArr ' <-- copy test data into array

Bạn xem giúp mình được không ? Dùng sự kiện textbox change ( hay afterupdate cũng được )

Thanks .
Nhấp chuột vào đây để mở rộng...

BẠN LÀM NHƯ SAU:

Mã: 
Private Sub TextBox1_Change()
On Error Resume Next
Dim a(), r&, c&, rs&, cs&, MyArr
With ListView1
' Do some common settings
.ListItems.Clear
.View = lvwReport
.Gridlines = True
.HideColumnHeaders = False

With Range("A1:C65500")
If TextBox1 = "" Then
    MyArr = Filter2DArray(.Value, 1, "[", False)
Else
    MyArr = Filter2DArray(.Value, 1, TextBox1.Value & "*", False)
End If
'.Formula = "=COLUMN()& ""-""&ROW()"
a() = MyArr ' <-- copy test data into array
End With

' Copy test data from a() to ListView1
rs = UBound(a, 1)
cs = UBound(a, 2)

For r = 1 To rs
    With .ListItems.Add(, , a(r, 1))

        For c = 2 To cs
            .SubItems(c - 1) = a(r, c)
        Next
    End With
Next

End With
End Sub
 
Upvote 0
khoa140383 đã viết:
Chào cả nhà !!!

Sau một thời gian săn lùng trên mạng thì em tìm được code để nạp Array vào listview với tốc độ cực khủng. Nhưng bài sau đó em mò tiếp hàm Filter2D trên diễn đàn để áp dụng vào trường hợp này thì đang bị bó tay. Các bác xem dùm em nha. Em muốn hoàn thiện cái này để chuyển từ Listbox sang Listview.
Note : File này em muốn dùng Filter2D với cột 1 của Listview. Sau khi lọc thì sẽ xoá danh sách cũ và nạp ngược trở lại Listview các dòng thoả điều kiện.

Thanks all.
Have a nice day !!!
Nhấp chuột vào đây để mở rộng...

Xài Listview tốc độ rất nhanh, mình dùng Listview như một bảng chọn dữ liệu để search thì so sánh tốc độ với Listbox thì Listview nhanh hơn nhưng Listview lại không hỗ trợ Unicode như Listbox nên đây lại là một hạn chế.
 
Upvote 0
kyo đã viết:
Xài Listview tốc độ rất nhanh, mình dùng Listview như một bảng chọn dữ liệu để search thì so sánh tốc độ với Listbox thì Listview nhanh hơn nhưng Listview lại không hỗ trợ Unicode như Listbox nên đây lại là một hạn chế.
Nhấp chuột vào đây để mở rộng...

Listview không thể nào chạy nhanh hơn Listbox trong việc Add Item, tuy nhiên mặt mạnh của nó là giao diện đẹp có gridline, có tiêu đề cột, sort trong cột dễ dàng, ... khuyết điểm thì như bạn nói!
 
Upvote 0
kyo đã viết:
Xài Listview tốc độ rất nhanh, mình dùng Listview như một bảng chọn dữ liệu để search thì so sánh tốc độ với Listbox thì Listview nhanh hơn nhưng Listview lại không hỗ trợ Unicode như Listbox nên đây lại là một hạn chế.
Nhấp chuột vào đây để mở rộng...

Các bác đều nói đúng cả, Listview không hổ trợ Unicode, nhưng em đang làm cho công ty nước ngoài nên sài Font gì cũng được. Theo em thấy thì chính xác là Listview chậm hơn Listbox 1 tí. Nhưng bù lại nó có rất nhiều ưu điểm : Có thể dùng con lăn của chuột, có thể thay đổi kích thước, thứ tự cột dễ dàng, và còn thêm cái gridline nữa... nên em thích Listview hơn... Hj

Have a nice day !!!
 
Upvote 0
Nói cho công bằng, Listview nó hỗ trợ nhiều tính năng khác như sắp xếp, tìm kiếm, giao diện dễ nhìn và có thể định dạng theo điều kiện nữa.
 
Upvote 0
kyo đã viết:
Xài Listview tốc độ rất nhanh, mình dùng Listview như một bảng chọn dữ liệu để search thì so sánh tốc độ với Listbox thì Listview nhanh hơn nhưng Listview lại không hỗ trợ Unicode như Listbox nên đây lại là một hạn chế.
Nhấp chuột vào đây để mở rộng...
Ấy, cái này không đúng... Tôi cho rằng ListBox nhanh hơn, ít nhất ở 1 điểm: Nạp Array vào Listbox và gán ListBox vào Array sẽ không cần dùng đến vòng lập
Còn nếu bạn test khác hơn, chắc là có vấn đề gì đó chưa ổn trong code của bạn
-----------------
Với minhthien: Không phải món gì dùng đến Filter2DArray cũng tốt đâu (tùy chuyện mà xài)
Vì dữ liệu ít nên bạn không cảm nhận được, nếu dữ liệu nhiều thì sẽ khác... Rõ ràng phải tốn mấy lần lập trong hàm Filter2DArray, rồi lại phải tốn thêm 2 lần lập trong code nạp Listview... quá phí ---> Nếu là tôi thì trong quá trình nạp Listview, tôi sẽ dùng IF để loại trừ có phải đở nhọc nhằn hơn không?
 
Lần chỉnh sửa cuối:
Upvote 0
ndu96081631 đã viết:
Ấy, cái này không đúng... Tôi cho rằng ListBox nhanh hơn, ít nhất ở 1 điểm: Nạp Array vào Listbox và gán ListBox vào Array sẽ không cần dùng đến vòng lập
Còn nếu bạn test khác hơn, chắc là có vấn đề gì đó chưa ổn trong code của bạn
Nhấp chuột vào đây để mở rộng...

Vậy bác Ndu xem dùm em coi code của file này đã ổn chưa nha. Vì em sưu tầm được trên mạng, test thì thấy nó nhanh thật, nhưng không biết bên trong còn ẩn tình gì nữa không.

Best regards.
 
Upvote 0
sealand đã viết:
Nói cho công bằng, Listview nó hỗ trợ nhiều tính năng khác như sắp xếp, tìm kiếm, giao diện dễ nhìn và có thể định dạng theo điều kiện nữa.
Nhấp chuột vào đây để mở rộng...
Cho dù có 100 cái ưu điểm mà chỉ cần 1 khuyết điểm KHÔNG HỔ TRỢ UNICODE của bằng thừa thôi anh à
Thử nghĩ trong thời đại hội nhập, giao lưu với nước ngoài, ta làm sao thể hiện data tiếng Việt Unicode vào Listview cho Tây nhìn đây?
Giải pháp cũng có nhiều, nhưng tuyệt đối không phải là dùng font TCVN3
Gird control có thiếu gì... sao phải dùng đến Listview?
 
Upvote 0
khoa140383 đã viết:
Vậy bác Ndu xem dùm em coi code của file này đã ổn chưa nha. Vì em sưu tầm được trên mạng, test thì thấy nó nhanh thật, nhưng không biết bên trong còn ẩn tình gì nữa không.

Best regards.
Nhấp chuột vào đây để mở rộng...

Chưa ổn ở chổ cái gì cũng nạp vào Listview, kể cả giá trị rổng... Vì thế mà minhthien đã dùng thêm hàm Filter2DArray để loại bỏ các phần tử rổng
Nhưng theo tôi thì không cần, bạn có thể dùng IF để khống chế mà, chẳng hạn thế này:
PHP: 
For r = 1 To rs
  If a(r, 1) <> "" Then
    With .ListItems.Add(, , a(r, 1))
      For c = 2 To cs
        .SubItems(c - 1) = a(r, c)
      Next
    End With
  End If
Next
Test xem có phải tốc độ nhanh rất nhiều không? Ẹc... Ẹc...
 
Upvote 0
ndu96081631 đã viết:
Chưa ổn ở chổ cái gì cũng nạp vào Listview, kể cả giá trị rổng... Vì thế mà minhthien đã dùng thêm hàm Filter2DArray để loại bỏ các phần tử rổng
Nhưng theo tôi thì không cần, bạn có thể dùng IF để khống chế mà, chẳng hạn thế này:
PHP: 
For r = 1 To rs
  If a(r, 1) <> "" Then
    With .ListItems.Add(, , a(r, 1))
      For c = 2 To cs
        .SubItems(c - 1) = a(r, c)
      Next
    End With
  End If
Next
Test xem có phải tốc độ nhanh rất nhiều không? Ẹc... Ẹc...
Nhấp chuột vào đây để mở rộng...

Đúng như thầy nói, em thử trên 2000 dòng, 6 cột chạy rất nhanh, so với Add Item thông thường thì phải chờ vài giây.

Nạp cho Form ban đầu:

PHP: 
Private Sub UserForm_Initialize()
    Dim r As Long, c As Long, rs As Long, cs As Long
    Dim MyArr(), iCol As Long
    With ListView1
        '' Do some common settings
        .View = lvwReport
        .Gridlines = True
        .HideColumnHeaders = False
        '' Create the column headers
        For iCol = 1 To 6
            .ColumnHeaders.Add , , "COLUMN " & iCol, 100
        Next
        '' Populate test range with 6 columns of data
        MyArr = Range(Sheet1.Range("A1"), Sheet1.Range("A65536").End(xlUp)).Resize(, 6).Value
        '' Copy test data from a() to ListView1
        rs = UBound(MyArr, 1)
        cs = UBound(MyArr, 2)
        '' Add details:
        For r = 1 To rs
            If MyArr(r, 1) <> "" Then
                With .ListItems.Add(, , MyArr(r, 1))
                    For c = 2 To cs
                        .SubItems(c - 1) = MyArr(r, c)
                    Next
                End With
            End If
        Next
    End With
End Sub

Nạp theo điều kiện TextBox:

PHP: 
Private Sub TextBox1_Change()
    On Error Resume Next
    Dim r As Long, c As Long, rs As Long, cs As Long
    Dim MyArr(), MyArray()
    With ListView1
        .ListItems.Clear
        MyArray = Range(Sheet1.Range("A1"), Sheet1.Range("A65536").End(xlUp)).Resize(, 6).Value
        MyArr = Filter2DArray(MyArray, 1, TextBox1.Value & "*", False)
        
        rs = UBound(MyArr, 1)
        cs = UBound(MyArr, 2)
        
        For r = 1 To rs
            If MyArr(r, 1) <> "" Then
                With .ListItems.Add(, , MyArr(r, 1))
                    For c = 2 To cs
                        .SubItems(c - 1) = MyArr(r, c)
                    Next
                End With
            End If
        Next
    End With
End Sub
 

File đính kèm

  • arr & listview.rar
    27.9 KB · Đọc: 251
Upvote 0
@Bác minhthien : Sau khi test lại code của bác minhthien với 65500 dòng và chuyển sang sự kiện afterupdate cho textbox thì thấy kết quả tuyệt vời,chạy nhanh chóng mặt luôn ( em quen test cả bảng tính thôi ) hj... Cám ơn bác minhthien.

@Bác Ndu : Tuy là Listview chạy không nhanh bằng listbox, nhưng đây cũng là một giải pháp nữa cho mọi người có nhiều sự lựa chọn. Em thấy mình cung cấp được nhiều giải pháp thì càng tốt chứ, đúng không bác Ndu ?
Vd : điện thoại Nokia tốt, nhưng mẫu mã không được đẹp, Samsung, LG đẹp nhưng chịu va đập kém... Túm lại thì các công ty cứ đưa ra sản phẩm, còn quyền lựa chọn sử dụng lại thuộc về... "khách hàng"... hj

Have a nice day !!!
 
Upvote 0
khoa140383 đã viết:
@Bác minhthien : Sau khi test lại code của bác minhthien với 65500 dòng và chuyển sang sự kiện afterupdate cho textbox thì thấy kết quả tuyệt vời,chạy nhanh chóng mặt luôn ( em quen test cả bảng tính thôi ) hj... Cám ơn bác minhthien.

@Bác Ndu : Tuy là Listview chạy không nhanh bằng listbox, nhưng đây cũng là một giải pháp nữa cho mọi người có nhiều sự lựa chọn. Em thấy mình cung cấp được nhiều giải pháp thì càng tốt chứ, đúng không bác Ndu ?
Vd : điện thoại Nokia tốt, nhưng mẫu mã không được đẹp, Samsung, LG đẹp nhưng chịu va đập kém... Túm lại thì các công ty cứ đưa ra sản phẩm, còn quyền lựa chọn sử dụng lại thuộc về... "khách hàng"... hj

Have a nice day !!!
Nhấp chuột vào đây để mở rộng...
Đồng ý với bạn!
Nhưng ý tôi muốn nói rằng: Có thiếu gì Gird control để ta lựa chọn, đâu nhất thiết phải Listview
Nếu bạn cho rằng Listview có những ưu điểm hơn Listbox thì bạn hãy xem cái "thằng em" này:
http://www.giaiphapexcel.com/forum/...vấn-Excel-Database-vào-các-control-ở-Userform
Tôi nghĩ nó còn "ngầu" hơn rất nhiều... Tính năng vượt trội, lại hổ trợ Unicode
Ngoài ra còn có 1 lựa chọn khác là: SpreadSheet
 
Upvote 0
ndu96081631 đã viết:
Đồng ý với bạn!
Nhưng ý tôi muốn nói rằng: Có thiếu gì Gird control để ta lựa chọn, đâu nhất thiết phải Listview
Nếu bạn cho rằng Listview có những ưu điểm hơn Listbox thì bạn hãy xem cái "thằng em" này:
http://www.giaiphapexcel.com/forum/showthread.php?51394-ADO-Kết-nối-truy-vấn-Excel-Database-vào-các-control-ở-Userform
Tôi nghĩ nó còn "ngầu" hơn rất nhiều... Tính năng vượt trội, lại hổ trợ Unicode
Ngoài ra còn có 1 lựa chọn khác là: SpreadSheet
Nhấp chuột vào đây để mở rộng...

Cái thằng Grid đó khó cài đặt quá, kể cả thằng Spread, mấy cái này thư viện dễ bị mất nguồn, chẳng hiểu sao hết, muốn có nó để add control thì phải cài lại Win, thật là khổ!
 
Upvote 0
minhthien321 đã viết:
Cái thằng Grid đó khó cài đặt quá, kể cả thằng Spread, mấy cái này thư viện dễ bị mất nguồn, chẳng hiểu sao hết, muốn có nó để add control thì phải cài lại Win, thật là khổ!
Nhấp chuột vào đây để mở rộng...
Có control nào không phải cài đâu chứ, kể cả Listview ---> Nếu không cài Microsoft Windows Common Controls 6 thì lấy đâu ra Listview (nhiều khi trên máy có sẵn và thế là xài mà không hề biết)
Tôi mới vừa cài Windows 7, Office 2010 và cũng mới vừa cài 2 "thằng em" Gird kia ---> Tất cả đều OK, đâu có vấn đề gì chứ
Còn việc mất Additional Controls tôi cho rằng không phải do cài control mà ra ---> Phát hiện mới có thể là do dùng Office 2007 hoặc Office 2010 bản crack (cài riêng 1 mình Office 2003 ít thấy trường hợp này xãy ra) ---> Với bản crack, nếu không kết nối internet thì không sao, một khi kết nối internet là... tèo kể từ đó
Ẹc... Ẹc...
 
Upvote 0
Khui lại Listview và Arr

Hoàng Trọng Nghĩa đã viết:
Đúng như thầy nói, em thử trên 2000 dòng, 6 cột chạy rất nhanh, so với Add Item thông thường thì phải chờ vài giây.

Nạp cho Form ban đầu:

PHP: 
Private Sub UserForm_Initialize()
    Dim r As Long, c As Long, rs As Long, cs As Long
    Dim MyArr(), iCol As Long
    With ListView1
        '' Do some common settings
        .View = lvwReport
        .Gridlines = True
        .HideColumnHeaders = False
        '' Create the column headers
        For iCol = 1 To 6
            .ColumnHeaders.Add , , "COLUMN " & iCol, 100
        Next
        '' Populate test range with 6 columns of data
        MyArr = Range(Sheet1.Range("A1"), Sheet1.Range("A65536").End(xlUp)).Resize(, 6).Value
        '' Copy test data from a() to ListView1
        rs = UBound(MyArr, 1)
        cs = UBound(MyArr, 2)
        '' Add details:
        For r = 1 To rs
            If MyArr(r, 1) <> "" Then
                With .ListItems.Add(, , MyArr(r, 1))
                    For c = 2 To cs
                        .SubItems(c - 1) = MyArr(r, c)
                    Next
                End With
            End If
        Next
    End With
End Sub

Nạp theo điều kiện TextBox:

PHP: 
Private Sub TextBox1_Change()
    On Error Resume Next
    Dim r As Long, c As Long, rs As Long, cs As Long
    Dim MyArr(), MyArray()
    With ListView1
        .ListItems.Clear
        MyArray = Range(Sheet1.Range("A1"), Sheet1.Range("A65536").End(xlUp)).Resize(, 6).Value
        MyArr = Filter2DArray(MyArray, 1, TextBox1.Value & "*", False)
        
        rs = UBound(MyArr, 1)
        cs = UBound(MyArr, 2)
        
        For r = 1 To rs
            If MyArr(r, 1) <> "" Then
                With .ListItems.Add(, , MyArr(r, 1))
                    For c = 2 To cs
                        .SubItems(c - 1) = MyArr(r, c)
                    Next
                End With
            End If
        Next
    End With
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn anh Hoàng Trọng Nghĩa.
Mình thấy tốc độ rất nhanh. Mình muốn sử dụng code của anh để tìm kiếm tuy nhiên cái điều kiện tìm kiếm là: ưu tiên cho tìm kiếm ở cột A trước, nếu tìm không có ở cột A thì nhảy qua tìm ở cột B.
Mình có sửa lại code của anh một tý, khi thử đánh vùng tìm kiếm là "113" thì kết quả cho ra không đúng. Mình không biết bị sai chỗ nào nữa. Nhờ anh và mọi người chỉ giúp.

Trân trọng cảm ơn.
Mã: 
Private Sub TextBox1_Change()
    On Error Resume Next
    Dim r As Long, c As Long, rs As Long, cs As Long
    Dim MyArr(), MyArray()
    With ListView1
        .ListItems.Clear
        MyArray = Range(Sheet1.Range("A1"), Sheet1.Range("A65536").End(xlUp)).Resize(, 6).Value
        MyArr = Filter2DArray(MyArray, 1, TextBox1.Value & "*", False)
        
        rs = UBound(MyArr, 1)
        cs = UBound(MyArr, 2)
 [COLOR=#ff0000]       If rs = 0 Or cs = 0 Then
           MyArr = Range(Sheet1.Range("B1"), Sheet1.Range("B65536").End(xlUp)).Resize(, 6).Value
           MyArr = Filter2DArray(MyArray, 2, TextBox1.Value & "*", False)
        End If
        rs = UBound(MyArr, 1)
        cs = UBound(MyArr, 2)[/COLOR]
        For r = 1 To rs
            If MyArr(r, 1) <> "" Then
                With .ListItems.Add(, , MyArr(r, 1))
                    For c = 2 To cs
                        .SubItems(c - 1) = MyArr(r, c)
                    Next
                End With
            End If
        Next
    End With
End Sub
 
Upvote 0
vba_gpe đã viết:
Cảm ơn anh Hoàng Trọng Nghĩa.
Mình thấy tốc độ rất nhanh. Mình muốn sử dụng code của anh để tìm kiếm tuy nhiên cái điều kiện tìm kiếm là: ưu tiên cho tìm kiếm ở cột A trước, nếu tìm không có ở cột A thì nhảy qua tìm ở cột B.
Mình có sửa lại code của anh một tý, khi thử đánh vùng tìm kiếm là "113" thì kết quả cho ra không đúng. Mình không biết bị sai chỗ nào nữa. Nhờ anh và mọi người chỉ giúp.

Trân trọng cảm ơn.
Nhấp chuột vào đây để mở rộng...
Bạn vui lòng gửi cái File của bạn lên đi nhé!

À không cần, bạn chỉ cần thêm tí xíu thôi:

ở đoạn này:

Mã: 
[B]MyArr = Filter2DArray(MyArray, [COLOR=#ff0000]1[/COLOR], TextBox1.Value & "*", False)[/B]

Bạn thêm như vầy:

Mã: 
        [B]MyArr = Filter2DArray(MyArray, [COLOR=#ff0000]1[/COLOR], TextBox1.Value & "*", False)[/B]
        [COLOR=#0000cd][B]If TypeName(MyArr) <> "Variant()" Then
            MyArr = Filter2DArray(MyArray, [/B][/COLOR][COLOR=#ff0000][B]2[/B][/COLOR][COLOR=#0000cd][B], [/B][/COLOR][COLOR=#ff0000][B]CDbl[/B][/COLOR][COLOR=#0000cd][B](TextBox1.Value) & "*", False)
        End If[/B][/COLOR]

Có nghĩa rằng, nếu không tìm thấy ở cột 1 thì sẽ chuyển sang cột thứ 2 tìm kiếm.

Với kiểu này, bạn khai báo thay vì Dim MyArr(), MyArray() thì bạn chỉ cần khai Dim MyArr, MyArray
(không có 2 dấu ngoặc)

Mã: 
Private Sub TextBox1_Change()
    On Error Resume Next
    Dim r As Long, c As Long, rs As Long, cs As Long
    [COLOR=#ff0000][B]Dim MyArr, MyArray[/B][/COLOR]
    With ListView1
        .ListItems.Clear
        MyArray = Range(Sheet1.Range("A1"), Sheet1.Range("A65536").End(xlUp)).Resize(, 6).Value
        [B]MyArr = Filter2DArray(MyArray, [COLOR=#006400]1[/COLOR], TextBox1.Value & "*", False)[/B]
        [COLOR=#0000cd][B]If TypeName(MyArr) <> "Variant()" Then
            MyArr = Filter2DArray(MyArray, [/B][/COLOR][COLOR=#008080][B]2[/B][/COLOR][COLOR=#0000cd][B], [/B][/COLOR][COLOR=#ff0000][B]CDbl([/B][/COLOR][COLOR=#0000cd][B]TextBox1.Value[/B][/COLOR][COLOR=#ff0000][B])[/B][/COLOR][COLOR=#0000cd][B] & "*", False)
        End If[/B][/COLOR]
        
        rs = UBound(MyArr, 1)
        cs = UBound(MyArr, 2)
        
        For r = 1 To rs
            If MyArr(r, 1) <> "" Then
                With .ListItems.Add(, , MyArr(r, 1))
                    For c = 2 To cs
                        .SubItems(c - 1) = MyArr(r, c)
                    Next
                End With
            End If
        Next
    End With
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

H
Nhờ gở rối công thức Averageif trong sheet summary
Trả lời
5
Đọc
68
HieuCD
H
nnthoi1994
Tự động gửi tin nhắn skype thông qua VBA
    • Thích
Trả lời
16
Đọc
616
befaint
befaint
L
  • Question
Lấy nội dung chát trên skype về excel
Trả lời
8
Đọc
561
nnthoi1994
nnthoi1994
H
  • Question
xin các thầy cho em xin bảng quy ước màu trong vba
Trả lời
17
Đọc
11K
VetMini
V
hung2412
Cần giải đáp: Sau khi Auto Fit dòng thì dòng nó không tự co lại
Trả lời
1
Đọc
60
quyenpv
quyenpv
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom