Code lọc mảng

[NH_DK]

Em có ví dụ này mà làm mãi không có kết quả. Em đưa lên đây nhờ anh chị xem giúp em code này nhé. (Em vẫn yếu về phần mảng)

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Cll, Rng, Arr(), i
    Application.ScreenUpdating = False
    On Error Resume Next
    If Target.Address = "$B$1" Then
        Set Rng = S1.Range([a2], S1.[a65000].End(3))
        ReDim Arr(1 To Vung.Rows.Count, 1 To 3): i = 1
        For Each Cll In Rng.Offset(, 2)
            If Cll.Offset(, 2) = Range("B1") Then
                Arr(i, 1) = Cll.Resize(, 1)
                Arr(i, 2) = Cll.Offset(, 1).Resize(, 1)
                Arr(i, 3) = Cll.Offset(, 3).Resize(, 1)
            End If
            i = i + 1
        Next Cll
    Range("A4:C10000").Clear
    Range("A4").Resize(i, 3) = Arr
    End If
End Sub

 

[SA_DQ]

Theo mình, bạn tạm thời vô hiệu hoá dòng lệnh On Error Resume Next đi cái đã!

Khi đó bạn sẽ đễ thấy 2 lỗi:

Set Rng = S1.Range([a2], S1.[a65000].End(3))

Hình như S1 ta chưa cho máy đó là cái chi cả; (Bạn không có trang tính nào là S1 cả)

Nếu có S1 đi chăng nữa thì vẫn thiếu cái mà mình gọi là tiếp đầu ngữ cho [A2];

Còn nữa, trong dòng lệnh

ReDim Arr(1 To Vung.Rows.Count, 1 To 3)

ban chưa cho máy biết Vung là vùng nào, ở đâu

Đây chỉ là fát hiện về cú fáp thôi; giải thuật thì bàn tiếp nếu . . .

 

[concogia]

Em có ví dụ này mà làm mãi không có kết quả. Em đưa lên đây nhờ anh chị xem giúp em code này nhé. (Em vẫn yếu về phần mảng)

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cll, Rng, Arr(), i
Application.ScreenUpdating = False
On Error Resume Next
If Target.Address = "$B$1" Then
Set Rng = S1.Range([a2], S1.[a65000].End(3))
ReDim Arr(1 To Vung.Rows.Count, 1 To 3): i = 1
For Each Cll In Rng.Offset(, 2)
If Cll.Offset(, 2) = Range("B1") Then
Arr(i, 1) = Cll.Resize(, 1)
Arr(i, 2) = Cll.Offset(, 1).Resize(, 1)
Arr(i, 3) = Cll.Offset(, 3).Resize(, 1)
End If
i = i + 1
Next Cll
Range("A4:C10000").Clear
Range("A4").Resize(i, 3) = Arr
End If
End Sub

Hình như là thế này

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Cll, Rng, Arr(), i
        If Target.Address = "$B$1" Then
        Set Rng = S1.Range(S1.[a2], S1.[a65000].End(3))
        ReDim Arr(1 To Rng.Rows.Count, 1 To 3): i = 1
        For Each Cll In Rng
            If Cll.Offset(, 2) = Range("B1") Then
                Arr(i, 1) = Cll
                Arr(i, 2) = Cll.Offset(, 1)
                Arr(i, 3) = Cll.Offset(, 3)
                i = i + 1
            End If
        Next Cll
    Range("A4:C10000").Clear
    Range("A4").Resize(i, 3) = Arr
    End If
End Sub

Thân

 

[sealand]

Đây đâu phải là code lọc mảng. Cơ chế rà soát vẫn dựa trên Range mà lại rà từng ô 1 thì chắc chắn chậm hơn find hoặc Filter. Code của bạn dữ liệu nhiều thì chắc tốn tiền Cafe lắm.
Nếu đã là lọc mảng thì phải nạp dữ liệu vào mảng rồi dùng cơ chế lọc trên mảng nguồn. Trên cơ sở đó so sánh tốc độ nếu hiệu quả hơn mới dùng còn chậm hơn find hay Filter thì cũng Goodbye thôi

 

[ndu96081631]

Đây đâu phải là code lọc mảng. Cơ chế rà soát vẫn dựa trên Range mà lại rà từng ô 1 thì chắc chắn chậm hơn find hoặc Filter. Code của bạn dữ liệu nhiều thì chắc tốn tiền Cafe lắm.
Nếu đã là lọc mảng thì phải nạp dữ liệu vào mảng rồi dùng cơ chế lọc trên mảng nguồn. Trên cơ sở đó so sánh tốc độ nếu hiệu quả hơn mới dùng còn chậm hơn find hay Filter thì cũng Goodbye thôi

Em dám chắc 100% rằng dùng mảng sẽ nhanh hơn Find hoặc Filter
Anh xem ở đây:
http://www.giaiphapexcel.com/forum/showthread.php?47929-Sort-mảng-2-chiều&p=306919#post306919
Ngoài ra, để đơn giản hóa vấn đề, nếu dữ liệu không nhiều lắm, ta dùng Advanced Filter cho nó gọn

 

[sealand]

Đây là ví dụ về code lọc mảng, bạn tham khảo trong file.

Sub Loc()
Dim tam, Mg()
Dim i, j, n
Sheet1.[A5:H65536].Clear
tam = Sheet2.Range(Sheet2.[A2], Sheet2.[H65536].End(3))
ReDim Mg(UBound(tam, 1) - 1, 7)
For i = 1 To UBound(tam, 1)
If tam(i, 7) = Sheet1.[D2] Then
For j = 0 To 7
Mg(n, j) = tam(i, j + 1)
Next j
n = n + 1
End If
Next i
Sheet1.[A5].Resize(UBound(Mg, 1), 8) = Mg
End Sub

Mình thấy lọc trên mảng nhanh thật, ví dụ mã "LE" là nhiều vậy mà rẹt 1 cái cũng OK

 

[Lê Duy Thương]

Đây là ví dụ về code lọc mảng, bạn tham khảo trong file.

Sub Loc()
Dim tam, Mg()
Dim i, j, n
Sheet1.[A5:H65536].Clear
tam = Sheet2.Range(Sheet2.[A2], Sheet2.[H65536].End(3))
ReDim Mg(UBound(tam, 1) - 1, 7)
For i = 1 To UBound(tam, 1)
If tam(i, 7) = Sheet1.[D2] Then
For j = 0 To 7
Mg(n, j) = tam(i, j + 1)
Next j
n = n + 1
End If
Next i
Sheet1.[A5].Resize(UBound(Mg, 1), 8) = Mg
End Sub

Mình thấy lọc trên mảng nhanh thật, ví dụ mã "LE" là nhiều vậy mà rẹt 1 cái cũng OK

vẫn chưa nhanh bằng pivot bác sealand ơi
thường loại dữ liệu như thế này em dùng công cụ có sẵn không à
hi hi

 

[sealand]

vẫn chưa nhanh bằng pivot bác sealand ơi
thường loại dữ liệu như thế này em dùng công cụ có sẵn không à
hi hi

Mình phải theo yêu cầu của tác giả chứ? Đây là code lọc để tạo sổ chi tiết thì sao? Nhất là những file tiện ích thì chả lẽ lại bảo người dùng khi nào cần hãy Pivot nhé!!!
Có những file người lập tránh dùng công thức hay các công cụ chạy ngầm khác để tăng tốc độ tối đa cho file thì sao? Nếu để Pivot thì khi file hoạt động nó cũng cập nhật Pivot chiếm dụng tài nguyên khi không cần thiết đến kết quả của Pivot. Đây cũng là việc đáng lưu tâm đối với những file dữ liệu lớn đấy bạn ạ. Thà lúc xem báo cáo chậm 1 chút còn hơn lúc sử lý file ngắm đồng hồ cát thì buồn lắm.