Dùng phương thức Find bị lỗi nếu nguồn lấy kết quả chỉ có 1 dòng

[AnhThu-1976]

Em chào Thầy cô và Anh chị
Em sưu tầm phương thức Find và áp dụng cho file của em

Sub TimTenMaTK()
    Dim i As Long
    Dim KqArr, Ma
    Dim K As Range, Khoi As Range

    With ActiveSheet
        '1. Côòt muôìn doÌ
        Ma = .Range(.[D2], .[D65536].End(3)).Value    ' maÞ doÌ
        '2. DoÌ õÒ côòt
        Set K = .Range(.[I2], .[I50].End(3))    ' khôìi maÞ doÌ ðêÒ tiÌm
        '3. Redim Khôìi kêìt quaÒ vaÌ tiÌm
        ReDim KqArr(1 To UBound(Ma, 1), 1 To 2)
        For i = 1 To UBound(Ma, 1)
            If Ma(i, 1) <> "" Then
                Set Khoi = K.Find(Ma(i, 1), K(K.Count), xlValues, xlWhole)    ' bãìt ðâÌu tiÌm
                If Not Khoi Is Nothing Then
                    KqArr(i, 1) = Khoi.Offset(, 1)
                    KqArr(i, 2) = Khoi.Offset(, 2)
                End If
            End If
        Next i
        .Range("E2").Resize(UBound(KqArr), 2).Value = KqArr
        '************************************
        Dim cll As Range, iii As Long
        iii = Range("D" & Rows.Count).End(xlUp).Row
        For Each cll In Range("E2:F" & iii)
            cll.Interior.ColorIndex = 0
            If cll.Value = "" Then
                cll.Interior.ColorIndex = 3    'N
            End If
        Next
        '********************
    End With
End Sub

Bình thường tại sheet TON vẫn chạy đúng
Nhưng bây giờ tại sheet TON em xóa bớt số liệu từ A3 đến F5 rồi chạy code thì nó báo lỗi tại dòng

ReDim KqArr(1 To UBound(Ma, 1), 1 To 2)

Em nhờ Thầy cô và Anh chị khắc phục giúp em lỗi này
Em cảm ơn!

 

[ptm0412]

Thêm If vào bên trên, End If ở dưới

Sub TimTenMaTK()
    Dim i As Long, Dongcuoi As Long
    Dim KqArr, Ma
    Dim K As Range, Khoi As Range

    With ActiveSheet
        Dongcuoi = .[D65536].End(3).Row
        Set K = .Range(.[I2], .[I50].End(3))
        If Dongcuoi = 1 Then Exit Sub
        If Dongcuoi = 2 Then
            Ma = .[D2]
            Set Khoi = K.Find(Ma, K(K.Count), xlValues, xlWhole)
            If Not Khoi Is Nothing Then
                .[E2] = Khoi.Offset(, 1)
                .[F2] = Khoi.Offset(, 2)
            End If

        Else
        '1. Côòt muôìn doÌ'
            Ma = .Range(.[D2], .[D65536].End(3)).Value  
        '2. DoÌ õÒ côòt'
        ReDim KqArr(1 To UBound(Ma, 1), 1 To 2)
            For i = 1 To UBound(Ma, 1)
                If Ma(i, 1) <> "" Then
                    Set Khoi = K.Find(Ma(i, 1), K(K.Count), xlValues, xlWhole)  
                    If Not Khoi Is Nothing Then
                        KqArr(i, 1) = Khoi.Offset(, 1)
                        KqArr(i, 2) = Khoi.Offset(, 2)
                    End If
                End If
            Next i
            .Range("E2").Resize(UBound(KqArr), 2).Value = KqArr
        End If
        '************************************

 

[AnhThu-1976]

Thêm If vào bên trên, End If ở dưới

Dạ em cảm ơn Thầy nhiều!