Châu Vĩnh Phúc
Châu Vĩnh Phúc
Thảo luận 6 thảo luận
Vỗ tay 0 vỗ tay
Lượt xem 642 lượt xem

xíu khi file thực tế chạy VBA thì hiện lỗi ntn thì là lỗi gì ạ và khắc

Cho em hỏi xíu với ạ, khi em làm file thực tế chạy VBA thì hiện lỗi ntn thì là lỗi gì ạ, và khắc phục làm sao ạ?


Thảo luận 6 câu trả lời
Lượt xem 642 lượt xem
Vỗ tay vỗ tay
Châu Vĩnh Phúc 09:10 - Oct 07, 2020

Để khắc phục lỗi này bạn vui lòng gửi kèm code hoặc file nhé, vì chỉ dựa trên thông báo lỗi sẽ không biết lỗi ở đâu, cần xem cụ thể trên code

Vỗ tay vỗ tay
Châu Vĩnh Phúc 00:10 - Oct 09, 2020

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 & ":P" & 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(rngCho.Offset(, 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 fixed by QM" & 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


Vỗ tay vỗ tay
Châu Vĩnh Phúc 00:10 - Oct 09, 2020

nhấn vào debug thì nó ra nz ạ

Vỗ tay vỗ tay
Châu Vĩnh Phúc 09:10 - Oct 09, 2020

Bạn để ý dòng code có ghi Sheets("NKC") nhưng trong file của bạn không có Sheet nào có tên là NKC (nhìn ở cửa sổ Project không có).

Do đó câu lệnh này bị lỗi.

Vỗ tay vỗ tay
Châu Vĩnh Phúc 08:10 - Oct 10, 2020


Vỗ tay vỗ tay
Châu Vĩnh Phúc 08:10 - Oct 10, 2020

vẫn đoạn code đó nhung hiện lỗi ntn là sao ạ

lỗi run-time error 13 ạ

Vỗ tay vỗ tay
Câu hỏi liên quan
© 2020 - Bản quyền của Công Ty Cổ Phần Công Nghệ Giáo Dục Gitiho Việt Nam
Giấy chứng nhận Đăng ký doanh nghiệp số: 0109077145, cấp bởi Sở Kế hoạch và Đầu tư TP. Hà Nội
Giấy phép mạng xã hội số: 588, cấp bởi Bộ Thông tin và Truyền thông