Application-defined or object-defined error là lỗi gì

Question

VBA run-time error 1004 is known as an Application-Defined or Object-Defined error which occurs while the code is running. Making coding errors (See our Error Handling Guide) is an unavoidable aspect learning VBA but knowing why an error occurs helps you to avoid making errors in future coding.

Nội dung chính Show

VBA Error 1004 – Object does not exist
VBA Error 1004 – Name Already Taken
VBA Error 1004 – Incorrectly Referencing an Object
VBA Error 1004 – Object Not Found

VBA Error 1004 – Object does not exist

If we are referring to an object in our code such as a Range Name that has not been defined, then this error can occur as the VBA code will be unable to find the name.

Sub CopyRange()  
  Dim CopyFrom As Range  
  Dim CopyTo As Range  
  Set CopyFrom = Sheets(1).Range("CopyFrom")  
  Set CopyTo = Sheets(1).Range("CopyTo")  
  CopyFrom.Copy  
CopyTo.PasteSpecial xlPasteValues  
End Sub

The example above will copy the values from the named range “CopyFrom” to the named range “CopyTo” – on condition of course that these are existing named ranges! If they do not exist, then the Error 1004 will display.

The simplest way to avoid this error in the example above is to create the range names in the Excel workbook, or refer to the range in the traditional row and column format eg: Range(“A1:A10”).

VBA Error 1004 – Name Already Taken

The error can also occur if you are trying to rename an object to an object that already exists – for example if we are trying to rename Sheet1 but the name you are giving the sheet is already the name of another sheet.

Sub NameWorksheet()  
  ActiveSheet.Name = "Sheet2"  
End Sub

If we already have a Sheet2, then the error will occur.

VBA Error 1004 – Incorrectly Referencing an Object

The error can also occur when you have incorrectly referenced an object in your code. For example:

Sub CopyRange()  
  Dim CopyFrom As Range  
  Dim CopyTo As Range  
  Set CopyFrom = Range("A1:A10")  
  Set CopyTo = Range("C1:C10")  
  Range(CopyFrom).Copy  
  Range(CopyTo).PasteSpecial xlPasteValues  
End Sub

This will once again give us the Error 10004

Correct the code, and the error will no longer be shown.

Sub CopyRange()  
  Dim CopyFrom As Range  
  Dim CopyTo As Range  
  Set CopyFrom = Range("A1:A10")  
  Set CopyTo = Range("C1:C10")  
  CopyFrom.Copy  
  CopyTo.PasteSpecial xlPasteValues  
End Sub

VBA Error 1004 – Object Not Found

This error can also occur when we are trying to open a workbook and the workbook is not found – the workbook in this instance being the object that is not found.

I have a button in one of the sheets (sheet"Welcome") And the button calls the form, when I put the data in the text boxes, I would like to put the data in another sheet ("OportunidadesemAberto") when I click the commandbutton2. But nothing happens, it changes the view of the "oportunidadesemaberto" sheet, but the error appears in that line.

Private Sub CommandButton2_Click()
  Sheets("OportunidadesemAberto").Activate
  Range("A2").Select
  Dim sh As Worksheet
  Set sh = ThisWorkbook.Sheets("OportunidadesemAberto")
  Dim le As Long
  lr = Sheets("OportunidadesemAberto").Range("A" & Rows.Count).End(x1up).Row
  With sh
    .Cells(lr + 1, "A").Value = Me.TextBox1.Value
    .Cells(lr + 1, "B").Value = Me.TextBox2.Value
    .Cells(lr + 1, "C").Value = Me.TextBox3.Value
    .Cells(lr + 1, "D").Value = Me.TextBox4.Value
    .Cells(lr + 1, "E").Value = Me.TextBox5.Value
    .Cells(lr + 1, "F").Value = Me.TextBox6.Value
    .Cells(lr + 1, "G").Value = Me.TextBox7.Value
    .Cells(lr + 1, "H").Value = Me.TextBox8.Value
    .Cells(lr + 1, "I").Value = Me.TextBox9.Value
    .Cells(lr + 1, "J").Value = Me.ComboBox1.Value
    .Cells(lr + 1, "K").Value = Me.ComboBox2.Value
    .Cells(lr + 1, "L").Value = Me.ComboBox3.Value
  End With
End Sub

I checked the trust center, and the error's still here. I tried to pass the data to other sheets. nothing works

When I debug it, then it shows this error:

Run-time error '1004':
Application-defined or object-defined error

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

là ai Data type VBA This worksheet VBA Select cell VBA Range column VBA