Xóa dữ liệu thì bị báo lỗi run time "13" tylemismatch

[tphan19]

Mấy anh xem giúp em code này khi xóa dữ liệu củ thì báo lỗi run time "13" tyle mismatch và code dừng không chạy nữa.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim MaTP As String
Dim lastRowDM As Integer, RowCount As Integer, i As Integer, j As Integer
Dim DataArr As Variant

'Kiem tra xem có phai thay doi tren cot C hay khong
If Target.Column = 3 Then
Application.EnableEvents = False
'Lay thong so dau vao
MaTP = Target.Value
lastRowDM = Sheets("DM_NVL").Range("D" & Rows.Count).End(xlUp).Row
RowCount = WorksheetFunction.CountIf(Sheets("DM_NVL").Range("D21" & lastRowDM), MaTP)

'Kiem tra dieu kien co so lieu
If RowCount > 0 Then

'Chen so dong trong de dien dinh muc tuong ung
Sheets("XUAT_VT").Range(Target.Row + 1 & ":" & Target.Row + RowCount - 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove


'Dien so lieu
DataArr = Sheets("DM_NVL").Range("D21:J" & lastRowDM).Value
For i = LBound(DataArr, 1) To UBound(DataArr, 1)
If DataArr(i, 1) = MaTP Then
Sheets("XUAT_VT").Range("C" & Target.Row + j).Value = MaTP
Sheets("XUAT_VT").Range("E" & Target.Row + j).Value = DataArr(i, 2)
Sheets("XUAT_VT").Range("F" & Target.Row + j).Value = DataArr(i, 3)
Sheets("XUAT_VT").Range("G" & Target.Row + j).Value = DataArr(i, 4)
Sheets("XUAT_VT").Range("J" & Target.Row + j).Value = DataArr(i, 7)
j = j + 1

End If
Next
End If
Application.EnableEvents = True
End If
End Sub

 

[hungpecc1]

Mấy anh xem giúp em code này khi xóa dữ liệu củ thì báo lỗi run time "13" tyle mismatch và code dừng không chạy nữa.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim MaTP As String
Dim lastRowDM As Integer, RowCount As Integer, i As Integer, j As Integer
Dim DataArr As Variant

'Kiem tra xem có phai thay doi tren cot C hay khong
If Target.Column = 3 Then
Application.EnableEvents = False
'Lay thong so dau vao
MaTP = Target.Value
lastRowDM = Sheets("DM_NVL").Range("D" & Rows.Count).End(xlUp).Row
RowCount = WorksheetFunction.CountIf(Sheets("DM_NVL").Range("D21" & lastRowDM), MaTP)

'Kiem tra dieu kien co so lieu
If RowCount > 0 Then

'Chen so dong trong de dien dinh muc tuong ung
Sheets("XUAT_VT").Range(Target.Row + 1 & ":" & Target.Row + RowCount - 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove


'Dien so lieu
DataArr = Sheets("DM_NVL").Range("D21:J" & lastRowDM).Value
For i = LBound(DataArr, 1) To UBound(DataArr, 1)
If DataArr(i, 1) = MaTP Then
Sheets("XUAT_VT").Range("C" & Target.Row + j).Value = MaTP
Sheets("XUAT_VT").Range("E" & Target.Row + j).Value = DataArr(i, 2)
Sheets("XUAT_VT").Range("F" & Target.Row + j).Value = DataArr(i, 3)
Sheets("XUAT_VT").Range("G" & Target.Row + j).Value = DataArr(i, 4)
Sheets("XUAT_VT").Range("J" & Target.Row + j).Value = DataArr(i, 7)
j = j + 1

End If
Next
End If
Application.EnableEvents = True
End If
End Sub

thử đưa file đính kèm test coi ntn

 

[tphan19]

thử đưa file đính kèm test coi ntn

File day anh, cột nhập liệu màu đỏ, xóa dữ liệu nguyên hàng để nhập liệu mới thì báo lỗi runtime

 

[snow25]

File day anh, cột nhập liệu màu đỏ, xóa dữ liệu nguyên hàng để nhập liệu mới thì báo lỗi runtime

Mình thì không thấy bị lỗi.Nhưng mà lỗi do code không chạy nữa nguyên do dòng này.

Application.EnableEvents = False

Nó đã tắt chức năng này rồi.