Excel lỗi runtime error 1004 application defined or object defined

[tiennv1]

Hi GPE,

Mình đang chạy file để xử lý dữ liệu nhưng bị lỗi "Application defined or object defined", và hiện ra bảng Debug như hình dưới.
Ai giúp mình xử lý lỗi này với ạ!!!

 

[befaint]

Hi GPE,

Mình

Ba GPE,
Mình phóng to cửa sổ code rồi chụp hình xinh xinh, be bé gửi lên đây.

 

[tiennv1]

Ba GPE,
Mình phóng to cửa sổ code rồi chụp hình xinh xinh, be bé gửi lên đây.

mình chụp code như này được chưa ạ, hay là chụp từ đầu tới cuối luôn ạ.

 

[befaint]

Thôi, chép code lên đi bạn ơi. Hình xấu quá.

 

[tiennv1]

Thôi, chép code lên đi bạn ơi. Hình xấu quá.

Option Explicit
Public sSoCT As String
Dim curCho&, curNhan&
Dim curSLCho As Double, curSLNhan As Double
Dim curSLChoDu As Double, curSLNhanThieu As Double, SLChia As Double
Dim rngCho As Range, rngNhan As Range, rngData As Range, rngDMTK As Range
Dim endR&, eRow&, eR&, iR&, iRow&, SoDong&
Dim i&, j&, k&, m&, s&, T&, u&, n&
Dim DemNo&, DemCo&, Dem&, dongDau&, iCT&
Dim Wf As WorksheetFunction, Dic As Object
Const ColTkNo = 8: Const ColTkCo = 9: Const RowEnd = 400000
Dim Arr(), ArrNo(), ArrCo(), ArrTK(), arrCho(), arrNhan(), ArrSap(), ArrDM(), ArrSoCT()
Dim Tg
Dim ArrKq(1 To 2000, 1 To 16)
Sub TaoRng()
Set Wf = WorksheetFunction
iRow = 2 'dong dau NKC
With Sheets("NKC")
.Range("A" & iRow & "" & RowEnd).ClearContents
End With
With Sheets("Tmp")
endR = .Range("A" & RowEnd).End(xlUp).Row
ArrTK = .Range(.Cells(2, 14), .Cells(u, 16)).Value
End With
dongDau = 0
eRow = UBound(ArrTK)
For iCT = 1 To eRow
sSoCT = ArrTK(iCT, 1) 'so CT
Dem = ArrTK(iCT, 2) + ArrTK(iCT, 3) 'so lan N + C
If Dem = 0 Then GoTo exit_for
''*******************************************************'
''Day la phan tinh toan cac TH, co ban la xac dinh cac vung RngCho va RngNhan'
DemNo = ArrTK(iCT, 2) 'so lan N'
DemCo = ArrTK(iCT, 3) 'so lan C'
TaoSubRng
''**************************************************
'Truong hop nay la toan No
If DemCo = 0 Then
TinhToan07
GoTo exit_for
End If
''**************************************************
''Truong hop nay la toan Co
If DemNo = 0 Then
TinhToan08
GoTo exit_for
End If
''**************************************************
''Truong hop khac - TH nay nhieu nhat
'Truong hop nay la soct vua co No vua co Co
Select Case Dem
Case 2
''luc nay DemNo=1 va demCo =1
TinhToan01
Case Is > 2 'so record > 2
''Them 1 TH neu so TK No = So TK Co, STien No(1)=sotienco(1), SotienNo(end)=sotienco(end)
If Dem < 5 And DemNo = DemCo Then
If rngNhan(1, 9) = rngCho(1, 8) And rngNhan(DemCo, 9) = rngCho(DemNo, 8) Then
TinhToan04
GoTo exit_for
End If
End If
If DemNo = 1 Then 'quan he 1N nhieu C
TinhToan02
GoTo exit_for
End If
If DemCo = 1 Then 'quan he 1C nhieu N
TinhToan03
GoTo exit_for
End If
''quan he nhieu no nhieu co
If Wf.CountIf(rngChffset(, 7).Resize(, 1), "<0") = DemNo Then
''Truong hop nay la so tien No toan am
TinhToan06
GoTo exit_for
Else
TinhToan05
GoTo exit_for
End If
End Select
exit_for:
dongDau = dongDau + Dem
If dongDau >= endR Then Exit Sub
Next iCT
Erase ArrTK, arrCho(), arrNhan(), ArrKq
Set rngCho = Nothing: Set rngNhan = Nothing
End Sub
Sub TaoNKC()
With Application
.ScreenUpdating = False: .DisplayAlerts = False: .Calculation = xlCalculationManual: .EnableEvents = False
End With
Tg = Timer
Sheets("NKC").Select
Sheets("NKC").AutoFilterMode = False
'Co the them 1 UDF kiem tra sh Tmp da ton tai
If SheetExists("Tmp") Then
With Sheets("Tmp")
.Cells.ClearContents
.[B1] = "SoCT" 'them tieu de
.[N1] = "SoCT": .[O1] = "DemNo": .[P1] = "DemCo": .[Q1] = "NgayHT"
End With
'Neu chua co thi add
Else
Sheets.Add
ActiveSheet.Name = "Tmp"
End If
ConvertGoc2Tmp
TaoTmp
TaoRng
'*********************************
XuLySoCT
Sheets("Tmp").Delete
MsgBox "Cam on ban da su dung - Dien dan Giai phap Excel" & Chr(13) & Timer - Tg
With Application
.ScreenUpdating = True: .DisplayAlerts = True: .Calculation = xlCalculationAutomatic: .EnableEvents = True
End With
End Sub
Sub TaoSubRng()
With Sheets("Tmp")
If DemNo = 0 Then
Set rngNhan = .Cells(2 + dongDau, 2).Offset(DemNo, -1).Resize(DemCo, 13)
GoTo bien
End If
If DemCo = 0 Then
Set rngCho = .Cells(2 + dongDau, 2).Offset(, -1).Resize(DemNo, 12)
GoTo bien
End If
Set rngCho = .Cells(2 + dongDau, 2).Offset(, -1).Resize(DemNo, 12)
Set rngNhan = .Cells(2 + dongDau, 2).Offset(DemNo, -1).Resize(DemCo, 13)
bien:
arrCho = rngCho.Value: arrNhan = rngNhan.Value
End With
End Sub
Sub XuLySoCT()
Dim endR&, i&
Dim Arr(), ArrSoTT()
Dim aSplit() As String
Dim SearchChar$
SearchChar = ";"
With Sheets("NKC")
.AutoFilterMode = False
endR = .Cells(RowEnd, 1).End(3).Row
Arr = .Range("B2:B" & endR).Value
End With
ReDim ArrSoTT(1 To UBound(Arr), 1 To 1)
For i = 1 To UBound(Arr)
aSplit() = Split(Arr(i, 1), SearchChar)
Arr(i, 1) = aSplit(1)
ArrSoTT(i, 1) = i
Next i
With Sheets("NKC")
.Range("B2:B" & endR).Value = Arr
.Range("F2:F" & endR).Value = ArrSoTT
End With
Erase Arr, ArrSoTT
End Sub

Sub GanArr()
With Sheets("NKC")
.Cells(iRow, 1).Resize(SoDong, 9) = ArrKq
End With
iRow = iRow + SoDong
Erase ArrKq
End Sub
Sub TaoTmp()
With Sheets("Tmp")
.AutoFilterMode = False
endR = .Cells(RowEnd, 2).End(xlUp).Row
Arr = .Range("A2:M" & endR + 1).Value 'them +1'
End With
endR = UBound(Arr)
ReDim ArrNo(1 To endR, 1 To 13), ArrCo(1 To endR, 1 To 13), ArrTK(1 To endR, 1 To 7)
s = 0: T = 0: u = 1
For i = 1 To endR - 1
'Gan phan no
If Arr(i, 8) <> 0 Then 'sotien no <>0
s = s + 1
For k = 1 To 4
ArrNo(s, k) = Arr(i, k)
Next k
If Arr(i, 12) <> 0 Then
For k = 10 To 11
ArrNo(s, k) = Arr(i, k)
Next k
ArrNo(s, 12) = Arr(i, 12)
ArrNo(s, 6) = Arr(i, 12) / Arr(i, 8)
End If
ArrNo(s, 5) = "N"
ArrNo(s, 7) = CStr(Arr(i, 7)) ' & Arr(i, 5)) SHTK & CostStr
ArrNo(s, 8) = Arr(i, 8) 'so tien
ArrTK(u, 2) = ArrTK(u, 2) + 1 ' dem so N
ArrTK(u, 5) = ArrTK(u, 5) + Arr(i, 8) 'so tien N
End If
'Gan phan co
If Arr(i, 9) <> 0 Then 'sotien co <>0
T = T + 1
For k = 1 To 4
ArrCo(T, k) = Arr(i, k)
Next k
If Arr(i, 13) <> 0 Then
For k = 10 To 11
ArrCo(T, k) = Arr(i, k)
Next k
ArrCo(T, 13) = Arr(i, 13)
ArrCo(T, 6) = Arr(i, 13) / Arr(i, 9)
End If
ArrCo(T, 5) = "C"
ArrCo(T, 7) = CStr(Arr(i, 7)) '& Arr(i, 5)) 'SHTK & CostStr
ArrCo(T, 9) = Arr(i, 9) 'so tien
ArrTK(u, 3) = ArrTK(u, 3) + 1 ' dem so C
ArrTK(u, 6) = ArrTK(u, 6) + Arr(i, 9) 'so tien C
End If
'tao DM TK duy nhat voi dieu kien la soct da sort******
ArrTK(u, 1) = Arr(i, 2) 'soct
ArrTK(u, 4) = Arr(i, 1) 'NgayHT
ArrTK(u, 7) = ArrTK(u, 6) - ArrTK(u, 5) 'Chenh lech
If ArrTK(u, 1) <> Arr(i + 1, 2) Then u = u + 1
'co nen gan bien dem vao
Next i
With Sheets("tmp")
.[B1] = "SoCT"
.Range("A2:M" & RowEnd).ClearContents
.Range("N2:Q" & RowEnd).ClearContents
.Range("A2").Resize(s, 13) = ArrNo
.Range("A2").Offset(s, 0).Resize(T, 13) = ArrCo
.[N1] = "SoCT": .[O1] = "DemNo": .[P1] = "DemCo": .[Q1] = "NgayHT"
.Range("N2").Resize(u, 7) = ArrTK
End With
Erase Arr(), ArrNo(), ArrCo(), ArrTK
With Sheets("Tmp")
endR = s + T + 1
'sort tmp
Set rngData = .Range(.Cells(1, 1), .Cells(endR, 13))
With .Sort
With .SortFields
.Clear
.Add Key:=Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending 'Dieu kien 1 ngayCT
.Add Key:=Range("B1"), SortOn:=xlSortOnValues, Order:=xlAscending 'Dieu kien 2 soct
.Add Key:=Range("H1"), SortOn:=xlSortOnValues, Order:=xlAscending 'Dieu kien 4 Tien No
.Add Key:=Range("I1"), SortOn:=xlSortOnValues, Order:=xlAscending 'Dieu kien 5 Tien co
End With
.SetRange rngData
.Header = xlYes ' co tieu de hay khong'
.Apply
End With
'sort soct duy nhat
Set rngData = .Range("N2:Q" & u)
With .Sort
With .SortFields
.Clear
.Add Key:=rngData.Cells(1, 4), SortOn:=xlSortOnValues, Order:=xlAscending 'Dieu kien 1 ngayHT
.Add Key:=rngData.Cells(1, 1), SortOn:=xlSortOnValues, Order:=xlAscending 'Dieu kien 2 soct
End With
.SetRange rngData
.Header = xlNo ' co tieu de hay khong'
.Apply
End With
End With
Set rngData = Nothing
End Sub
Sub ConvertGoc2Tmp()
Dim ArrKq()
With Sheets("NKCGoc")
.AutoFilterMode = False
endR = .Cells(RowEnd, 1).End(3).Row
Arr = .Range("A3:I" & endR).Value
End With
ReDim ArrKq(1 To UBound(Arr), 1 To 9)
s = 0
For i = 1 To UBound(Arr)
If Len(Arr(i, 7)) > 0 Then
s = s + 1
ArrKq(s, 1) = Arr(i, 1)
ArrKq(s, 2) = Arr(i, 1) & ";" & Arr(i, 2)
ArrKq(s, 3) = Arr(i, 3)
ArrKq(s, 7) = CStr(Arr(i, 7))
ArrKq(s, 4) = Arr(i, 4)
ArrKq(s, 5) = Arr(i, 5)
ArrKq(s, 6) = Arr(i, 6)
ArrKq(s, 8) = Arr(i, 8) * 1
ArrKq(s, 9) = Arr(i, 9) * 1
End If

Next i
With Sheets("Tmp")
.[A2].Resize(RowEnd, 9).ClearContents
.[A2].Resize(s, 9) = ArrKq
Set rngData = .Range("A2:I" & s + 1)
With .Sort
With .SortFields
.Clear
.Add Key:=rngData.Cells(1, 1), SortOn:=xlSortOnValues, Order:=xlAscending 'Dieu kien 1 ngayHT
.Add Key:=rngData.Cells(1, 2), SortOn:=xlSortOnValues, Order:=xlAscending 'Dieu kien 2 soct
.Add Key:=rngData.Cells(1, 3), SortOn:=xlSortOnValues, Order:=xlAscending 'Dieu kien 2 ngayCT
End With
.SetRange rngData
.Header = xlNo ' co tieu de hay khong'
.Apply
End With
End With
Erase Arr(), ArrKq()
Set rngData = Nothing
End Sub
Sub TaoShTmp()
With Application
.ScreenUpdating = False: .DisplayAlerts = False: .Calculation = xlCalculationManual: .EnableEvents = False
End With
If SheetExists("Tmp") Then
With Sheets("Tmp")
.AutoFilterMode = False
.Cells.ClearContents
.[B1] = "SoCT" 'them tieu de
.[N1] = "SoCT": .[O1] = "DemNo": .[P1] = "DemCo": .[Q1] = "NgayHT"
.[R1] = "PSNo": .[S1] = "PSCo"
End With
'Neu chua co thi add
Else
Sheets.Add
ActiveSheet.Name = "Tmp"
End If
ConvertGoc2Tmp
TaoTmp
With Application
.ScreenUpdating = True: .DisplayAlerts = True: .Calculation = xlCalculationAutomatic: .EnableEvents = True
End With
Sheets("Tmp").Select
Range("N1").Select

End Sub
Private Function SheetExists(shName) As Boolean
Dim x As Object
On Error Resume Next
Set x = ActiveWorkbook.Sheets(shName)
If Err = 0 Then SheetExists = True _
Else SheetExists = False
End Function
Sub TinhToan01()
'Truong hop nay danh cho 1N va 1C - Dem=2
SoDong = 1
ArrKq(SoDong, 1) = arrNhan(1, 1) 'ngay HT
ArrKq(SoDong, 2) = sSoCT 'SoCT
ArrKq(SoDong, 3) = arrNhan(1, 3) 'NgayCT
ArrKq(SoDong, 4) = arrNhan(1, 4) 'diengiai
ArrKq(SoDong, ColTkNo) = arrCho(1, 7) 'TKNo
ArrKq(SoDong, ColTkCo) = arrNhan(1, 7) 'TKCo;
ArrKq(SoDong, 7) = arrNhan(1, 9) 'sotien
'********************************
If arrNhan(1, 6) > 0 Then
ArrKq(SoDong, 14) = arrNhan(1, 10) 'MaKH
ArrKq(SoDong, 15) = arrNhan(1, 11) 'TenKH
ArrKq(SoDong, 16) = Round(arrNhan(1, 6) * ArrKq(SoDong, 7), 0) 'ST VND
End If
GanArr
End Sub
Sub TinhToan05()
curCho = 0: curNhan = 0: s = 1
curSLNhanThieu = 0: curSLChoDu = 0: SLChia = 0
'Phan nay la nhieu no nhieu co
Do While Not (curCho = UBound(arrCho) And curSLChoDu = 0)
If curSLChoDu = 0 Then
curCho = curCho + 1
curSLCho = arrCho(curCho, 8)
curSLChoDu = curSLCho
End If
If curSLNhanThieu = 0 Then
curNhan = curNhan + 1
curSLNhan = arrNhan(curNhan, 9)
curSLNhanThieu = curSLNhan
End If
If Abs(curSLChoDu) <= Abs(curSLNhanThieu) Then
SLChia = curSLChoDu
Else
SLChia = curSLNhanThieu
End If
'Xem lai phan nay xu ly tru so am
ArrKq(s, 1) = arrCho(curCho, 1) 'Ngay HT
ArrKq(s, 2) = sSoCT 'SoCT
ArrKq(s, 3) = arrCho(curCho, 3) 'NgayCT
ArrKq(s, 4) = arrCho(curCho, 4) 'Dien giai
ArrKq(s, ColTkNo) = arrCho(curCho, 7) ' TK No
ArrKq(s, ColTkCo) = arrNhan(curNhan, 7) ' TK Co
ArrKq(s, 7) = SLChia 'So tien
' If arrCho(curCho, 6) > 0 Then
' ArrKQ(s, 14) = arrCho(curCho, 10) 'MaKH
' ArrKQ(s, 15) = arrCho(curCho, 11) 'TenKH
' ArrKQ(s, 16) = Round(arrCho(curCho, 6) * ArrKQ(s, 7), 0) 'ST VND
' End If
curSLChoDu = curSLChoDu - SLChia
curSLNhanThieu = curSLNhanThieu - SLChia
s = s + 1
Loop
SoDong = s - 1
GanArr
End Sub
'Phan code duoi day it khi dung
'*********************************************
Sub TinhToan06()
curCho = 0: curNhan = 0: s = 1
curSLNhanThieu = 0: curSLChoDu = 0: SLChia = 0
'With Sheets("NKC")
'***---------------------------------------------------------
'Phan nay la nhieu no nhieu co vµ tat ca la so <0
Do While Not (curCho = UBound(arrCho) And curSLChoDu = 0)
If curSLChoDu = 0 Then
curCho = curCho + 1
curSLCho = arrCho(curCho, 8)
curSLChoDu = curSLCho
End If
If curSLNhanThieu = 0 Then
curNhan = curNhan + 1
curSLNhan = arrNhan(curNhan, 9)
curSLNhanThieu = curSLNhan
End If
If curSLChoDu >= curSLNhanThieu Then 'lay so < lon hon
SLChia = curSLChoDu
Else
SLChia = curSLNhanThieu
End If
ArrKq(s, 1) = arrCho(curCho, 1) 'Ngay HT
ArrKq(s, 2) = sSoCT 'SoCT
ArrKq(s, 3) = arrCho(curCho, 3) 'NgayCT
ArrKq(s, 4) = arrCho(curCho, 4) 'Dien giai
ArrKq(s, ColTkNo) = arrCho(curCho, 7) ' TK No
ArrKq(s, ColTkCo) = arrNhan(curNhan, 7) ' TK Co
ArrKq(s, 7) = SLChia 'So tien
If arrCho(curCho, 6) > 0 Then 'Ti gia
ArrKq(s, 14) = arrCho(curCho, 10) 'MaKH
ArrKq(s, 15) = arrCho(curCho, 11) 'TenKH
ArrKq(s, 16) = Round(ArrKq(s, 7) * arrCho(curCho, 6), 0) 'VND
End If
curSLChoDu = curSLChoDu - SLChia
curSLNhanThieu = curSLNhanThieu - SLChia
s = s + 1
Loop
SoDong = s - 1
GanArr
End Sub

Sub TinhToan02()
'Truong hop nay danh cho 1N va many C - Dem>2
SoDong = UBound(arrNhan)
n = 1 '1 No
For i = 1 To SoDong
For k = 1 To 4
ArrKq(i, k) = arrNhan(i, k) '4 cot dau
Next k
For k = 14 To 16
ArrKq(i, k) = arrNhan(i, k - 4) '3 cot sau
Next k
ArrKq(i, ColTkNo) = arrCho(n, 7) 'TKNo
ArrKq(i, ColTkCo) = arrNhan(i, 7) 'TKCo
ArrKq(i, 7) = arrNhan(i, 9) 'So tien
If arrNhan(i, 6) > 0 Then
ArrKq(i, 14) = arrNhan(i, 10) 'MaKH
ArrKq(i, 15) = arrNhan(i, 11) 'TenKH
ArrKq(i, 16) = Round(arrNhan(i, 6) * ArrKq(i, 7), 0) 'ST VND
End If
Next i
GanArr
End Sub
Sub TinhToan03()
'Truong hop nay danh cho 1C va many N - Dem>2
'TH nay nguoc voi TinhToan02 - be care Tuan
SoDong = UBound(arrCho)
n = 1 '1 No
For i = 1 To SoDong
For k = 1 To 4
ArrKq(i, k) = arrCho(i, k) '4 cot dau
Next k
ArrKq(i, ColTkNo) = arrCho(i, 7) 'TKNo
ArrKq(i, ColTkCo) = arrNhan(n, 7) 'TKCo
ArrKq(i, 7) = arrCho(i, 8) 'So tien
If arrCho(i, 6) > 0 Then
ArrKq(i, 14) = arrCho(i, 10) 'MaKH
ArrKq(i, 15) = arrCho(i, 11) 'TenKH
ArrKq(i, 16) = Round(arrCho(i, 6) * ArrKq(i, 7), 0) 'ST VND
End If
Next i
GanArr
End Sub
Sub TinhToan04()
' TH neu so TK No = So TK Co, STien No(1)=sotienco(1), SotienNo(end)=sotienco(end)
'MsgBox "OK"
SoDong = UBound(arrCho)
For i = 1 To SoDong
For k = 1 To 4
ArrKq(i, k) = arrCho(i, k) '4 cot dau
Next k
ArrKq(i, ColTkNo) = arrCho(i, 7) 'TKNo
ArrKq(i, ColTkCo) = arrNhan(i, 7) 'TKCo
ArrKq(i, 7) = arrCho(i, 8) 'So tien
If arrCho(i, 6) > 0 Then
ArrKq(i, 14) = arrCho(i, 10) 'MaKH
ArrKq(i, 15) = arrCho(i, 11) 'TenKH
ArrKq(i, 16) = Round(arrCho(i, 6) * ArrKq(i, 7), 0) 'ST VND
End If
Next i
GanArr
End Sub
Sub TinhToan07()
' TH neu co nhieu TK No va khong co TK Co
SoDong = UBound(arrCho)
For i = 1 To SoDong
For k = 1 To 4
ArrKq(i, k) = arrCho(i, k) '4 cot dau
Next k
For k = 10 To 3
ArrKq(i, k) = arrCho(i, k) '4 cot sau
Next k
ArrKq(i, ColTkNo) = arrCho(i, 7) 'TKNo
ArrKq(i, ColTkCo) = "" 'TKCo
ArrKq(i, 7) = arrCho(i, 8) 'So tien
If arrCho(i, 6) > 0 Then
ArrKq(i, 14) = arrCho(i, 10) 'MaKH
ArrKq(i, 15) = arrCho(i, 11) 'TenKH
ArrKq(i, 16) = Round(arrCho(i, 6) * ArrKq(i, 7), 0) 'ST VND
End If
Next i
GanArr
End Sub
Sub TinhToan08()
' TH neu co nhieu TK Co va khong co TK No
SoDong = UBound(arrNhan)
n = 1 '1 No
For i = 1 To SoDong
For k = 1 To 4
ArrKq(i, k) = arrNhan(i, k) '4 cot dau
Next k
For k = 10 To 13
ArrKq(i, k) = arrNhan(i, k) '4 cot sau
Next k
ArrKq(i, ColTkNo) = "" 'arrCho(n, 7) 'TKNo
ArrKq(i, ColTkCo) = arrNhan(i, 7) 'TKCo
ArrKq(i, 7) = arrNhan(i, 9) 'So tien
If arrNhan(i, 6) > 0 Then
ArrKq(i, 14) = arrNhan(i, 10) 'MaKH
ArrKq(i, 15) = arrNhan(i, 11) 'TenKH
ArrKq(i, 16) = Round(arrNhan(i, 6) * ArrKq(i, 7), 0) 'ST VND
End If
Next i
GanArr
End Sub
Sub TaoSoCtNew()
Dim endR&, i&, s&, sTmp$, SoDong&
Dim Arr(), ArrKq()
Const RowEnd = 400000
With Sheets("NKC-Tmp")
.AutoFilterMode = False
endR = .Cells(RowEnd, 2).End(3).Row
Arr = .Range("A8:I" & endR).Value
End With
ReDim ArrKq(1 To UBound(Arr), 1 To 9)
s = 1: SoDong = 0
sTmp = "xxxxx"
For i = 1 To UBound(Arr)
If i > 1 Then sTmp = Arr(i - 1, 2)
If CStr(Arr(i, 2)) <> CStr(sTmp) Then SoDong = SoDong + 1
If Len(Arr(i, 7)) > 0 Then
ArrKq(s, 1) = Arr(i, 1)
ArrKq(s, 2) = Right("0000" & SoDong, 5) & ";" & Arr(i, 2)
ArrKq(s, 3) = Arr(i, 3)
ArrKq(s, 7) = CStr(Arr(i, 7))
ArrKq(s, 4) = Arr(i, 4)
ArrKq(s, 5) = Arr(i, 5)
ArrKq(s, 6) = Arr(i, 6)
ArrKq(s, 8) = Arr(i, 8) * 1
ArrKq(s, 9) = Arr(i, 9) * 1
s = s + 1
End If
Next i
If s Then
With Sheets("NKCGoc")
.Range("A3:I" & endR).ClearContents
.[A3].Resize(s, 9) = ArrKq
End With
End If
Erase Arr(), ArrKq()
End Sub

Bài đã được tự động gộp: 12/3/21

đây bạn ơi

 

[befaint]

Option Explicit

Cho nội dung code vào thẻ CODE đi bạn, hoặc gửi file lên cho nhanh.

 

[SA_DQ]

. . . . . . . . . .. . . . . . ..

 

[tiennv1]

hay mình gửi file dữ liệu qua chứ code k điền vào được phần CODE

 

[HieuCD]

mình chụp code như này được chưa ạ, hay là chụp từ đầu tới cuối luôn ạ.
View attachment 255301

Kiểm tra lại s=?, có khả năng không có phát sinh bên nợ

 

[tiennv1]

Kiểm tra lại s=?, có khả năng không có phát sinh bên nợ

Tại mình cũng dùng file để xử lý dữ liệu nhiều, mà đây lần đầu code bị lỗi như vậy ạ.

 

[befaint]

hay mình gửi file dữ liệu qua chứ code k điền vào được phần CODE
View attachment 255304

Anh @Hai Lúa Miền Tây xem xét chỗ giới hạn 15 ký tự này xem. Có trường hợp lúng túng không đăng được bài.

 

[HieuCD]

Tại mình cũng dùng file để xử lý dữ liệu nhiều, mà đây lần đầu code bị lỗi như vậy ạ.

Thử hay
.Range("A2").Resize(s, 13) = ArrNo
Bằng
if s>0 then .Range("A2").Resize(s, 13) = ArrNo

 

[tiennv1]

Thử hay
.Range("A2").Resize(s, 13) = ArrNo
Bằng
if s>0 then .Range("A2").Resize(s, 13) = ArrNo

dạ để mình thử xem