Lỗi khi rút trích dữ liệu theo 2 điều kiện

[thanhphuongvip]

Mình có một bảng dữ liệu như này:


Mình sang sheet khác để lọc ra những dòng thỏa 2 điều kiện là Tên Khách hàng và tên Sản phẩm


Và code nó như này:

Sub ruttrich2()
Dim Sarr() As Variant, Darr() As Variant
Dim Lr As Long, DK As String, i As Long, r As Long, k As Long, j As Long

    Lr = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
    Sarr = Sheet1.Range("A2:E" & Lr).Value
    r = UBound(Sarr)
   
    ReDim Darr(1 To r, 1 To 5)
    DK = Range("I2")
    For i = 1 To r
        If Sarr(i, 3) = DK And Sarr(i, 4) = Range("J2") Then
            k = k + 1
            For j = 1 To 5
                Darr(k, j) = Sarr(i, j)
            Next j
        End If
    Next i

Sheet2.Range("A2").Resize(1000, 5).ClearContents
Sheet2.Range("A2").Resize(k, 5) = Darr

End Sub

Và kết quả là: Khi có kết quả thỏa mãn 2 điều kiện thì nó lọc ra được, còn nếu như ko có kết quả thì nó báo lỗi.

Xin anh em cho hỏi mình sai chỗ nào ạ? xin cảm ơn

 

[Phuocam]

Thêm bẫy lỗi:

If K> 0 then Sheet2.Range("A2").Resize(k, 5) = Darr

 

[SA_DQ]

Vẫn còn tiềm ẩn 1 lỗi nữa, sau khi:

Thêm bẫy lỗi:

Nếu lần chạy trước con số K lớn hơn con số K lần này thì kết quả sẽ là trời ơi!
Cho nên sau dòng lệnh
ReDim Darr(1 To r, 1 To 5)
Ta nên thêm dòng:

Sheet2.Range("A2").Resize(r, 5) = Darr

Nói thêm: Lỗi này sẽ không có, nếu ta xài AdvancedFilter, có sự trợ giúp từ VBA

 

[leonguyenz]

Tham khảo AdvancedFilter:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Lr As Long, Rng As Range
Lr = Sheet1.Range("A65535").End(xlUp).Row
Set Rng = Sheet1.Range("A1:E" & Lr)
If Target.Address = "$I$2" Then
    Range("A2:E" & Lr).Clear
    Rng.AdvancedFilter 2, [I1:J2], [A1:E1]
End If
End Sub

 

[thanhphuongvip]

Tham khảo AdvancedFilter:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Lr As Long, Rng As Range
Lr = Sheet1.Range("A65535").End(xlUp).Row
Set Rng = Sheet1.Range("A1:E" & Lr)
If Target.Address = "$I$2" Then
    Range("A2:E" & Lr).Clear
    Rng.AdvancedFilter 2, [I1:J2], [A1:E1]
End If
End Sub

Công nhận cách AdvanceFilter này lợi hại, code ngắn ngọn nữa. Để mình bắt chước
Cho mình hỏi số 2 trong Rng.AdvancedFilter 2, [I1:J2], [A1:E1] nó nghĩa là gì vậy bạn?

 

[leonguyenz]

Công nhận cách AdvanceFilter này lợi hại, code ngắn ngọn nữa. Để mình bắt chước
Cho mình hỏi số 2 trong Rng.AdvancedFilter 2, [I1:J2], [A1:E1] nó nghĩa là gì vậy bạn?

Bạn xem hình ở dưới:
1 là Filter tại bảng dữ liệu
2 là Copy qua một vị trí khác

 

[SA_DQ]

Cho mình hỏi số 2 trong Rng.AdvancedFilter 2, [I1:J2], [A1:E1] nó nghĩa là gì vậy bạn?

Trường phái xài con số 2 này là trường phái thiếu ý thức vì cộng đồng & tự rước cực cho bộ nhớ bản thân!

Nói thêm:
Bạn thử bỏ câu lệnh này trong macro xem kết quả có khác gì so với lần chạy macro trước không:
Range("A2:E" & Lr).Clear

 

[thanhphuongvip]

Cảm ơn các bạn, mình đã làm được rồi! Đa tạ!

 

[kh0jy3n]

Tham khảo AdvancedFilter:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Lr As Long, Rng As Range
Lr = Sheet1.Range("A65535").End(xlUp).Row
Set Rng = Sheet1.Range("A1:E" & Lr)
If Target.Address = "$I$2" Then
    Range("A2:E" & Lr).Clear
    Rng.AdvancedFilter 2, [I1:J2], [A1:E1]
End If
End Sub

bác chu thix từng dòng một hộ em được không ạ để em áp dụng vào file báo cáo @@ . code hay ghê

 

[LamNA]

bác chu thix từng dòng một hộ em được không ạ để em áp dụng vào file báo cáo @@ . code hay ghê

Theo mình hiểu

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Lr As Long, Rng As Range

Lr = Sheet1.Range("A65535").End(xlUp).Row ' tạo dòng cuối có dữ liệu

Set Rng = Sheet1.Range("A1:E" & Lr) ' chọn vùng dữ liệu lọc

If Target.Address = "$I$2" Then ' điều kiện lọc

    Range("A2:E" & Lr).Clear ' xóa trước khi lọc

    Rng.AdvancedFilter 2, [I1:J2], [A1:E1] ' 2 có nghĩa lọc copy qua vùng khác còn 1 lọc trong vùng dữ liệu,   [I1:J2], [A1:E1]  tiêu đề để lọc

End If

End Sub

 

[leonguyenz]

bác chu thix từng dòng một hộ em được không ạ để em áp dụng vào file báo cáo @@ . code hay ghê

Bạn thử Record Marco dùng AdvancedFilter lọc theo điều kiện và Coppy qua vị trí khác xem nhé, các bước bạn làm như thế nào thì nó sẽ ghi lại (chỉ những gì được ghi, không phải thao tác nào cũng được ghi lại).

 

[kh0jy3n]

Bạn thử Record Marco dùng AdvancedFilter lọc theo điều kiện và Coppy qua vị trí khác xem nhé, các bước bạn làm như thế nào thì nó sẽ ghi lại (chỉ những gì được ghi, không phải thao tác nào cũng được ghi lại).

dạ vâng em cảm ơn ạ.
Chúc anh một ngày tốt lành .

Bài đã được tự động gộp: 25/4/19

Theo mình hiểu

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Lr As Long, Rng As Range

Lr = Sheet1.Range("A65535").End(xlUp).Row ' tạo dòng cuối có dữ liệu

Set Rng = Sheet1.Range("A1:E" & Lr) ' chọn vùng dữ liệu lọc

If Target.Address = "$I$2" Then ' điều kiện lọc

    Range("A2:E" & Lr).Clear ' xóa trước khi lọc

    Rng.AdvancedFilter 2, [I1:J2], [A1:E1] ' 2 có nghĩa lọc copy qua vùng khác còn 1 lọc trong vùng dữ liệu,   [I1:J2], [A1:E1]  tiêu đề để lọc

End If

End Sub

Hi cảm ơn anh nhiều ạ.
chúc anh một ngày tốt lành @@