Listbox bị lỗi khi dữ liệu tăng lên !! (1 người xem)

[khoa140383]

Các bác ơi,

Cho em hỏi mấy câu sau :

1.Tại sao listbox bị lỗi khi dữ liệu tăng lên khoảng trên 40.000 dòng ( không thể load userform có chứa listbox ) ?

2.Có cách nào khắc phục tình trạng trên không ?

3.Và có code nào để tăng tốc thời gian load giữ liệu từ sheet vào listbox không ( khi dữ liệu trên con số 20.000 dòng thì listbox load rất chậm ) ?

Note : vì dữ liệu của kho vừa dài, vừa nặng nên không thể gửi file đính kèm cho các bác được, nhưng em đã test trên 1 book mới và cũng thấy hiện tượng như trên.

Mong các bác nghiên cứu và đưa ra giải pháp giúp em.
Xin cám ơn

 

[sealand]

Việc load chậm hay lỗi là do cách load của bạn mà thôi. Mình đã test load cả 65536 dòng và 2 cột rẹt 1 nhát là xong

 

[khoa140383]

Việc load chậm hay lỗi là do cách load của bạn mà thôi. Mình đã test load cả 65536 dòng và 2 cột rẹt 1 nhát là xong

Có lẽ là kiến thức về VBA còn kém + mê chơi hơn mê học = làm đến đâu sai đến đó . Cái Form bị lỗi nó nằm ở đây. Mong các bác ra tay giúp đỡ. Cứ dữ liệu lên quá 10000 dòng là nó bị ì ạch... lên quá 40000 dòng là tịt ngòi luôn.

Xin cám ơn và chúc một ngày tốt lành !!!

 

[ndu96081631]

Có lẽ là kiến thức về VBA còn kém + mê chơi hơn mê học = làm đến đâu sai đến đó . Cái Form bị lỗi nó nằm ở đây. Mong các bác ra tay giúp đỡ. Cứ dữ liệu lên quá 10000 dòng là nó bị ì ạch... lên quá 40000 dòng là tịt ngòi luôn.

Xin cám ơn và chúc một ngày tốt lành !!!

Tôi nghĩ vấn đề trong file này nằm ở sub Nap và sub Nap1 ---> Bạn nên nghiên cứu cách nạp bằng Array ---> Tức gôm mọi dữ liệu cần thiết vào 1 mảng rồi nạp 1 lần duy nhất vào ListBox ---> Nạp theo kiểu AddItem là thua rồi (đã vậy còn làm việc trực tiếp trên cell nên tốc độ đã chậm lại càng chậm thêm)
Ngoài ra, việc dùng sự kiện TextBox_Change cũng nên xem lại... vì cứ gõ là code chạy (lãng phí) ---> Nên chăng ta chuyển sang sự kiện AfterUpdate?

 

[khoa140383]

Mong bác ndu96081631 và các bác nghiên cứu giúp đỡ dùm. Vì em biết VBA nhưng biết không hết và cũng chưa học qua trường lớp nào. File ở đây chỉ học trên GPE, tổng hợp từ các code có trên diễn đàn nên cũng "gà mờ" lắm. Hy vọng nhận được sự giúp đỡ từ các bác trên diễn đàn.

Đúng là càng học càng thấy mình dốt...
Xin cám ơn bác ndu96081631 !!

 

[ndu96081631]

Mong bác ndu96081631 và các bác nghiên cứu giúp đỡ dùm. Vì em biết VBA nhưng biết không hết và cũng chưa học qua trường lớp nào. File ở đây chỉ học trên GPE, tổng hợp từ các code có trên diễn đàn nên cũng "gà mờ" lắm. Hy vọng nhận được sự giúp đỡ từ các bác trên diễn đàn.

Đúng là càng học càng thấy mình dốt...
Xin cám ơn bác ndu96081631 !!

Hỏi thêm lần nữa:
- Trong code của bạn có sử dụng ChẹckBox, nó dùng cho mục đích gì mà sao tôi không thấy nó xuất hiện trên Form? (giấu để làm gì?)
- 2 TextBox dùng để LookUp hiện tại hình như đang dò tìm riêng biệt ---> Có cần kết hợp để tìm cùng lúc 2 điều kiện không?
---------------------
Hic... nguyên lý để tăng tốc là chuyển mọi thứ sang Array ---> Làm hoài nên cũng thấy... chán ---> Mà tôi thấy trong code bạn dùng hàm API từa lưa luôn, vậy lý nào bạn lại nói mình "gà mờ" chứ ---> Cao thủ nữa là đàng khác

 

[khoa140383]

Hỏi thêm lần nữa:
- Trong code của bạn có sử dụng ChẹckBox, nó dùng cho mục đích gì mà sao tôi không thấy nó xuất hiện trên Form? (giấu để làm gì?)
- 2 TextBox dùng để LookUp hiện tại hình như đang dò tìm riêng biệt ---> Có cần kết hợp để tìm cùng lúc 2 điều kiện không?
---------------------
Hic... nguyên lý để tăng tốc là chuyển mọi thứ sang Array ---> Làm hoài nên cũng thấy... chán ---> Mà tôi thấy trong code bạn dùng hàm API từa lưa luôn, vậy lý nào bạn lại nói mình "gà mờ" chứ ---> Cao thủ nữa là đàng khác

Xin được trả lời bác thế này :

1. Checkbox trong form không có tác dụng gì cả, vì ban đầu định kết hợp để dò tìm cho nhanh nhưng sau lại thôi.

2. 2 Textbox để lookup hiện tại để dò tìm riêng biệt : hoặc theo số tờ khai hải quan , hoặc theo số airwaybill nên cũng không cần kết hợp hai điều kiện làm gì.

3. Em xin thưa với bác là em rất rất "gà mờ"... còn cái hàm API gì gì đó cũng là tìm được từ các file trên diễn đàn thôi.

Cách học của em là :
Đưa ra định hướng
==> Lên diễn đàn tìm code
==> Ráp lại và chỉnh sữa cho nó chạy
==> Chạy ít thấy ok
==> Chạy nhiều báo lỗi, không chạy được nữa
==> Ngồi nhìn mãi tác phẩm lắp ráp của mình mà không biết nó bị lỗi tại đâu và làm sao sữa được
==> Ngồi bó tay và cắn lưỡi
==> sau đó chỉ còn cách post lên diễn đàn nhờ các bác sữa lại.

Mong bác ndu và các bác giúp dùm...

 

[thuyyeu99]

Bạn thử cái này xem sao

    Dim Arr() 
With Sheet20
  Arr = .Range("A2:H" & .Cells(65536, 2).End(xlUp).Row).Value
End With
  Me.ListBox1.List() = Arr

 

[khoa140383]

Bạn thử cái này xem sao

    Dim Arr() 
With Sheet20
  Arr = .Range("A2:H" & .Cells(65536, 2).End(xlUp).Row).Value
End With
  Me.ListBox1.List() = Arr

Cám ơn bạn đã giúp đỡ. Code của bạn cho mình test thì thấy rất ok, có gì khó khăn mong được bạn chỉ dẫn thêm.

Xin cám ơn bác ndu và thuyyeu99 .

 

[ndu96081631]

Xin được trả lời bác thế này :
1. Checkbox trong form không có tác dụng gì cả, vì ban đầu định kết hợp để dò tìm cho nhanh nhưng sau lại thôi.
2. 2 Textbox để lookup hiện tại để dò tìm riêng biệt : hoặc theo số tờ khai hải quan , hoặc theo số airwaybill nên cũng không cần kết hợp hai điều kiện làm gì.
3. Em xin thưa với bác là em rất rất "gà mờ"... còn cái hàm API gì gì đó cũng là tìm được từ các file trên diễn đàn thôi.

Tạm sửa lại code cho bạn thế này:

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
  (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
  (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Sub UserForm_Initialize()
  Dim sRng As Range, hWnd As Long
  hWnd = FindWindow("ThunderDFrame", Me.Caption)
  SetWindowLong hWnd, -16, &H84CA0080
  TextBox11.SetFocus
  With Sheet20
    .Select
    Set sRng = .Range(.[A2], .[A65536].End(xlUp)).Resize(, 8)
  End With
  ListBox1.List() = sFilter(sRng, "")
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  If CloseMode = vbFormControlMenu Then Cancel = True
End Sub

Private Sub CommandButton2_Click()
  Dim sRng As Range, iRow As Long
  If Trim(Me.TextBox12.Value) = "" Then
    Me.TextBox12.SetFocus
    Exit Sub
  End If
  With Sheet20
    iRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
    .Cells(iRow, 1).Value = TextBox12.Value
    .Cells(iRow, 2).Value = TextBox13.Value
    .Cells(iRow, 3).Value = TextBox14.Value
    .Cells(iRow, 4).Value = TextBox17.Value
    .Cells(iRow, 5).Value = TextBox15.Value
    .Cells(iRow, 6).Value = TextBox16.Value
    .Cells(iRow, 7).Value = TextBox20.Value
    .Cells(iRow, 8).Value = TextBox18.Value
    Set sRng = .Range(.[A2], .[A65536].End(xlUp)).Resize(, 8)
  End With
  ListBox1.List() = sFilter(sRng, "")
  ClearTextBox
  Me.TextBox12.SetFocus
End Sub

Private Sub CommandButton3_Click()
  Dim fRng As Range, sRng As Range
  Set fRng = Sheet20.Range("A:A").Find(Me.ListBox1, , xlValues, xlWhole)
  If Not fRng Is Nothing Then
    With fRng
      Set sRng = .Parent.Range(.Parent.[A2], .Parent.[A65536].End(xlUp)).Resize(, 8)
      .Offset(, 0).Value = TextBox12.Text
      .Offset(, 1).Value = TextBox13.Text
      .Offset(, 2).Value = TextBox14.Text
      .Offset(, 3).Value = TextBox17.Text
      .Offset(, 4).Value = TextBox15.Text
      .Offset(, 5).Value = TextBox16.Text
      .Offset(, 6).Value = TextBox20.Text
      .Offset(, 7).Value = TextBox18.Text
    End With
    ClearTextBox
    ListBox1.List() = sFilter(sRng, "")
  End If
End Sub

Private Sub CommandButton4_Click()
  Dim fRng As Range, sRng As Range
  With Sheet20
    Set sRng = .Range(.[A2], .[A65536].End(xlUp)).Resize(, 8)
    Set fRng = .Range("A:A").Find(Me.ListBox1, , xlValues, xlWhole)
  End With
  ClearTextBox
  If Not fRng Is Nothing Then
    fRng.EntireRow.Delete
    TextBox21.Value = ""
    ListBox1.List() = sFilter(sRng, "")
  End If
End Sub

Private Sub CommandButton5_Click()
  ClearTextBox
End Sub

Private Sub CommandButton6_Click()
  Dim sRng As Range
  With Sheet20
    Set sRng = .Range(.[A2], .[A65536].End(xlUp)).Resize(, 8)
  End With
  sRng.Sort sRng(2, 2), 2, Header:=xlYes
  ListBox1.List() = sFilter(sRng, "")
End Sub

Private Sub ListBox1_Click()
  With Me
    .TextBox12 = .ListBox1
    .TextBox13 = .ListBox1.Column(1)
    .TextBox14 = .ListBox1.Column(2)
    .TextBox17 = .ListBox1.Column(3)
    .TextBox15 = .ListBox1.Column(4)
    .TextBox16 = .ListBox1.Column(5)
    .TextBox20 = .ListBox1.Column(6)
    .TextBox18 = .ListBox1.Column(7)
  End With
End Sub

Private Sub CommandButton1_Click()
  Unload Me
End Sub

Private Sub TextBox21_AfterUpdate()
  Dim sRng As Range
  With Sheet20
    Set sRng = .Range(.[A2], .[A65536].End(xlUp)).Resize(, 8)
  End With
  ClearTextBox
  TextBox22.Text = ""
  ListBox1.List() = sFilter(sRng, TextBox21.Text)
End Sub

Private Sub TextBox22_AfterUpdate()
  Dim sRng As Range
  With Sheet20
    Set sRng = .Range(.[A2], .[A65536].End(xlUp)).Resize(, 8)
  End With
  ClearTextBox
  TextBox21.Text = ""
  ListBox1.List() = sFilter(sRng, TextBox22.Text, 2)
End Sub

Private Sub ClearTextBox()
  TextBox12.Value = ""
  TextBox13.Value = ""
  TextBox14.Value = ""
  TextBox17.Value = ""
  TextBox15.Value = ""
  TextBox16.Value = ""
  TextBox20.Value = ""
  TextBox18.Value = ""
End Sub

Private Function sFilter(sRng As Range, Criteria, Optional Col As Long = 1)
  Dim tmpArr, Arr, i As Long, j As Long, n As Long
  On Error GoTo ExitFunc
  If Criteria = "" Then
    sFilter = sRng.Value
    Exit Function
  End If
  tmpArr = sRng.Value
  ReDim Arr(1 To UBound(tmpArr, 1), 1 To UBound(tmpArr, 2))
  For i = 1 To UBound(tmpArr, 1)
    If InStr(tmpArr(i, Col), Criteria) = 1 Then
      n = n + 1
      For j = 1 To UBound(tmpArr, 2)
        Arr(n, j) = tmpArr(i, j)
      Next j
    End If
  Next i
  sFilter = Arr
ExitFunc:
End Function

Bạn kiểm tra lại nhé
Lưu ý:
Với ham sFilter, bạn có thể lọc bất cứ cột nào bạn muốn... Cú pháp là sFilter(Vùng dữ liệu, điều kiện, cột)
Theo mặc định thì:
- Nếu bạn bỏ tham số cột thì xem như là lọc theo điều kiện cột 1...
- Nếu điều kiện = "" thì xem như lấy toàn bộ dữ liệu
Ngoài ra, 2 TextBox dùng để LookUp tôi không dùng sự kiện Change mà dùng AfterUpdate ---> Vì thế, sau khi gõ vào, bạn bấm Enter 1 phát thì ListBox mới cập nhật (mục đích tăng tốc)
---------------------------------
Trời mẹ ơi... xem như sửa hết cha nó rồi còn gì ---> Hic... ham chi mấy trò này cho "đày đọa tấm thân" thế nhỉ? Mấy bài toán Array này làm hoài, giờ làm lại chẳng có gì hứng thú cả, lại cực như con.. CẨU

 

[khoa140383]

Trời mẹ ơi... xem như sửa hết cha nó rồi còn gì ---> Hic... ham chi mấy trò này cho "đày đọa tấm thân" thế nhỉ? Mấy bài toán Array này làm hoài, giờ làm lại chẳng có gì hứng thú cả, lại cực như con.. CẨU

Em xin cám ơn bác rất nhiều,

Vì không có cơ bản, chỉ sưu tầm code rồi ráp lại với nhau nên mới thế này đây. Mong bác đừng nản lòng, mà hãy vì đàn em thân yêu mà ra tay giúp đỡ những thành viên "gà mờ" như em... Vì "gà mờ" lúc nào cũng có, chú này đi thì chú khác xuất hiện.. hj hj.. Vả lại bác cũng có thời gian để ôn lại kiến thức cũ luôn, một công đôi việc mà.

Xin cám ơn và chúc bác có một ngày tốt lành..

 

[ThuNghi]

Tạm sửa lại code cho bạn thế này:
...
Trời mẹ ơi... xem như sửa hết cha nó rồi còn gì ---> Hic... ham chi mấy trò này cho "đày đọa tấm thân" thế nhỉ? Mấy bài toán Array này làm hoài, giờ làm lại chẳng có gì hứng thú cả, lại cực như con.. CẨU

Mình cũng hay làm Arr mà thấy NDU làm thấy quá hay, có nhiều điều học hỏi. Nhất là mấy cái Sub mà truyền tham chiếu.
Liệu NDU có thể Sort luôn trên mảng sau đó rồi gán xuống. Có thể sort trên arr với mảng hơn 1 chiều giống như mình nối Arr thành 1 và sort Arr, chả biết có tối ưu.
Cám ơn NDU.

 

[sealand]

Thông qua mảng nó cũng vẫn phải rà hết cái vùng lọc, mình có giải pháp là dùng sheet tạm để chơi. Mình kiên nhẫn chép khoảng 10.000 dòng làm ví dụ thì nó cũng chỉ chớp 1 cái là xong.
Mình bỏ hết code nap chỉ dùng chung 1 cái. Bạn tham khảo nha

Sub nap()
Dim Dk, k, j
Dim sh As Worksheet
On Error Resume Next
With Sheet20
Me.ListBox1.RowSource = ""
If CheckBox1 And TextBox21 = "" Or Not CheckBox1 And TextBox22 = "" Then
ListBox1.RowSource = .Name & "!" & .Range("A2:H" & .[A65536].End(3).Row).Address
Exit Sub
End If
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set sh = ThisWorkbook.Sheets.Add
sh.Name = "GPE"
k = IIf(CheckBox1, 1, 2)
Dk = IIf(CheckBox1, TextBox21, TextBox22)
Sheet1.Cells.Clear
.Range("A2:H" & .[A65536].End(3).Row).AutoFilter Field:=k, Criteria1:="*" & Dk & "*"
.Range("A2:H" & .[A65536].End(3).Row).SpecialCells(12).Copy Sheets("GPE").Range("A1")
 ListBox1.RowSource = "GPE!" & .Range("A1:H" & .[A65536].End(3).Row).Address
.Range("A2:H" & .[A65536].End(3).Row).AutoFilter
End With
Sheets("GPE").Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set sh = Nothing
End Sub

Mình xoá dữ liệu cho nhẹ bạn chép trở lại nha

 

[khoa140383]

Thông qua mảng nó cũng vẫn phải rà hết cái vùng lọc, mình có giải pháp là dùng sheet tạm để chơi. Mình kiên nhẫn chép khoảng 10.000 dòng làm ví dụ thì nó cũng chỉ chớp 1 cái là xong.
Mình bỏ hết code nap chỉ dùng chung 1 cái. Bạn tham khảo nha

Sub nap()
Dim Dk, k, j
Dim sh As Worksheet
On Error Resume Next
With Sheet20
Me.ListBox1.RowSource = ""
If CheckBox1 And TextBox21 = "" Or Not CheckBox1 And TextBox22 = "" Then
ListBox1.RowSource = .Name & "!" & .Range("A2:H" & .[A65536].End(3).Row).Address
Exit Sub
End If
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set sh = ThisWorkbook.Sheets.Add
sh.Name = "GPE"
k = IIf(CheckBox1, 1, 2)
Dk = IIf(CheckBox1, TextBox21, TextBox22)
Sheet1.Cells.Clear
.Range("A2:H" & .[A65536].End(3).Row).AutoFilter Field:=k, Criteria1:="*" & Dk & "*"
.Range("A2:H" & .[A65536].End(3).Row).SpecialCells(12).Copy Sheets("GPE").Range("A1")
 ListBox1.RowSource = "GPE!" & .Range("A1:H" & .[A65536].End(3).Row).Address
.Range("A2:H" & .[A65536].End(3).Row).AutoFilter
End With
Sheets("GPE").Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set sh = Nothing
End Sub

Mình xoá dữ liệu cho nhẹ bạn chép trở lại nha

Cám ơn sealand rất nhiều, cách dùng sheet tạm của bác cũng rất hay. Nhưng sau khi test lại thì thấy vẫn còn ì ạch lắm ( khi dữ liệu lên trên 40000 dòng ). Vì vậy cách hay nhất là dùng cách của bác NDU, code chạy nhanh - chính xác - không bị lỗi...
Dù sao cũng rất cám ơn bác đã quan tâm giúp đỡ mình.

Chúc bác có một ngày tốt lành !!

 

[ndu96081631]

Mình cũng hay làm Arr mà thấy NDU làm thấy quá hay, có nhiều điều học hỏi. Nhất là mấy cái Sub mà truyền tham chiếu.
Liệu NDU có thể Sort luôn trên mảng sau đó rồi gán xuống. Có thể sort trên arr với mảng hơn 1 chiều giống như mình nối Arr thành 1 và sort Arr, chả biết có tối ưu.
Cám ơn NDU.

Sort mảng chua chát lắm ThuNghi ơi (vì thế tôi dùng chức năng sort có sẳn) ---> Không biết chiêu dùng JScript có làm được trên mảng 2 chiều không nữa (nếu được thì chắc cũng chẳng dễ ăn)
----------------------------------

Thông qua mảng nó cũng vẫn phải rà hết cái vùng lọc, mình có giải pháp là dùng sheet tạm để chơi. Mình kiên nhẫn chép khoảng 10.000 dòng làm ví dụ thì nó cũng chỉ chớp 1 cái là xong.
Mình bỏ hết code nap chỉ dùng chung 1 cái. Bạn tham khảo nha

em cũng biết dùng Sheet phụ sẽ đơn giản nhưng sẽ không tổng quát nếu người ta mang code sang nơi khác để làm
Ngoài ra, nếu anh dùng AutoFilter rồi dùng SpecialCells(12) thì chắc chắn có lúc nào đó nó sẽ bị lỗi trên dữ liệu lớn mà sau khi filter nó bị phân chia ra thành nhiều Area (cái này chúng ta đã từng gặp rồi) ---> Có chăng ta dùng Advanced Filter mới an toàn anh à

 

[sealand]

Sort mảng chua chát lắm ThuNghi ơi (vì thế tôi dùng chức năng sort có sẳn) ---> Không biết chiêu dùng JScript có làm được trên mảng 2 chiều không nữa (nếu được thì chắc cũng chẳng dễ ăn)

Mình cũng để tâm chuyện này nhưng thực tế đến nay mình thấy với mảng đa chiều thì ngoài chuyện đảo dồn thì không có cách nào khác. Nhưng mình thấy trên 1 số diễn đàn có đề cập tới Hàm Filter hay hàm Sort... đối với mảng đa chiều nhưng nó lại thuộc ngôn ngữ C++ hay Java. Mà những món này thì mình mù tịt.
Giá có ai có khả năng viết thành Class rồi nhúng vào Exc thì may chăng.