Xin sữa lỗi code vba - (1 người xem)

[tuandat106]

Mình có file sử dụng VBA mình chọn lọc theo ô B2 tại sheet"thongke". không biết code sai chỗ nào. xin GPE sữa lỗi giúp ở file đính kèm. thanks nhiều ạ

 

[siwtom]

Mình có file sử dụng VBA mình chọn lọc theo ô B2 tại sheet"thongke". không biết code sai chỗ nào. xin GPE sữa lỗi giúp ở file đính kèm. thanks nhiều ạ

Code sai te tua

Private Sub Worksheet_Change(ByVal target As Range)
    If target.Address <> "$B$2" Then Exit Sub                          'vi tri chon de tim kiem
    Dim Arr(), ArrDL(), MyArr()
    [COLOR=#ff0000]Arr = Sheet5.Range("$B$5:P" & Sheet5.[P65500].End(3).Row).Value[/COLOR]
    MyArr = Filter2DArray(Arr, 1, target.Value, False)
    ReDim ArrDL(1 To UBound(MyArr), 1 To 15)

    For i = 1 To UBound(MyArr)
    [COLOR=#800000]ArrTen(i, 1) = MyArr(i, 2)
    ArrTen(i, 2) = MyArr(i, 3)
    ArrTen(i, 3) = MyArr(i, 4)
    ArrTen(i, 4) = MyArr(i, 5)
    ArrTen(i, 6) = MyArr(i, 7)
    ArrTen(i, 8) = MyArr(i, 9)
    ArrTen(i, 9) = MyArr(i, 10)
    ArrTen(i, 10) = MyArr(i, 11)
    ArrTen(i, 11) = MyArr(i, 12)
    ArrTen(i, 12) = MyArr(i, 13)
    ArrTen(i, 13) = MyArr(i, 14)
    ArrTen(i, 14) = M[/COLOR]yArr(i, 15)
    Next
    Range("B5:O300").ClearContents
    Range("B5").Resize(UBound(MyArr)).Value = ArrDL
End Sub

Dòng đỏ đỏ có vấn đề.
Ở sheet5, tức sheet Thongke, không có chút dữ liệu nào ở cột P vậy Sheet5.[P65500].End(3).Row = 1. Tức đi từ cell P65500 lên trên không gặp cell nào có dữ liệu nên sẽ lên mãi và dừng ở cell P1.
Nếu sửa lại thành Sheet2 - Data, vì tôi hiểu là lọc dữ liệu của sheet Data và kết quả nhập vào sheet Thongke, thì Sheet2.[P65500].End(3).Row = 3 (đi lên tới P3 = "Số container"). Kết quả vẫn sai vì lúc đó

Arr = Sheet2.Range("$B$5:P" & Sheet2.[P65500].End(3).Row).Value 
= Sheet2.Range("B5:P3").Value
= Sheet2.Range("B3:P5").Value

Tức chỉ có 3 dòng dữ liệu với dòng 1 là dòng tiêu đề (dòng 3 trên sheet Data)

Các dòng nâu nâu cũng sai. ArrTen là cái gì? Nhìn

ReDim [COLOR=#ff0000]ArrDL[/COLOR](1 To UBound(MyArr), 1 To 15)
...
Range("B5").Resize(UBound(MyArr)).Value = [COLOR=#ff0000]ArrDL[/COLOR]

thì tôi đoán đó là ArrDL
-----------
Code sửa lại. Những chỗ đỏ đỏ là tôi sửa hoặc thêm vào.

Private Sub Worksheet_Change(ByVal target As Range)
Dim Arr(), ArrDL(), MyArr
    If target.Address <> "$B$2" Then Exit Sub                          'vi tri chon de tim kiem
'    phai xoa ngay o dau vi neu khong co ket qua loc thi van ton tai du lieu loc cu, gay hieu lam
    Range("B5:O300").ClearContents
    Arr = Sheet2.Range("$B$[COLOR=#ff0000]4[/COLOR]:[COLOR=#ff0000]B[/COLOR]" & Sheet2.[[COLOR=#ff0000]B[/COLOR]65500].End(xlUp).Row)[COLOR=#ff0000].Resize(, 15)[/COLOR].Value
    MyArr = Filter2DArray(Arr, 1, target.Value, False)
'   phai kiem tra ket qua ma ham tra ve, co the la Empty
    [COLOR=#ff0000]If IsEmpty(MyArr) Then GoTo end_[/COLOR]
    ReDim ArrDL(1 To UBound(MyArr), 1 To [COLOR=#ff0000]14[/COLOR])
    For i = 1 To UBound(MyArr)
        [COLOR=#ff0000]ArrDL[/COLOR](i, 1) = MyArr(i, 2)
        ArrDL(i, 2) = MyArr(i, 3)
        ArrDL(i, 3) = MyArr(i, 4)
        ArrDL(i, 4) = MyArr(i, 5)
        ArrDL(i, 6) = MyArr(i, 7)
        ArrDL(i, 8) = MyArr(i, 9)
        ArrDL(i, 9) = MyArr(i, 10)
        ArrDL(i, 10) = MyArr(i, 11)
        ArrDL(i, 11) = MyArr(i, 12)
        ArrDL(i, 12) = MyArr(i, 13)
        ArrDL(i, 13) = MyArr(i, 14)
        [COLOR=#ff0000]ArrDL[/COLOR](i, 14) = MyArr(i, 15)
    Next
    Range("B5").Resize(UBound([COLOR=#ff0000]ArrDL[/COLOR]), [COLOR=#ff0000]UBound(ArrDL, 2)[/COLOR]).Value = ArrDL
end_:
End Sub

 

[tuandat106]

Bạn chỉ dẫn tận tình quá. thanks bạn siwtom rất nhiều