Giúp sửa code lấy số dư đầu kỳ!

Chia sẻ bởi:hands
★★★★★
Quảng cáo

Em chào thầy cô & anh chị
Em có code tạo số dư đầu kỳ tại sheet CNT01 như sau:(đứng tại sheet CNT01 chạy code)

Sub DauKy()   
    Dim i As Long
    Dim ArrDK, sArray, shh
    Dim n1 As Range
    Dim Wf As WorksheetFunction
    Set Wf = WorksheetFunction
    sArray = Range([B11], [B65536].End(3)).Resize(, 8).Value

Set shh = Sheets("CNT00")
    Set n1 = shh.Range(shh.[B11], shh.[B65536].End(3)).Resize(, 8)
    ReDim ArrDK(1 To UBound(sArray, 1), 1 To 2)
    For i = 1 To UBound(sArray, 1)

ArrDK(i, 1) = Wf.If(Wf.IsNA(Wf.VLookup(sArray(i, 1), n1, 7, 0)), 0, Wf.VLookup(sArray(i, 1), n1, 7, 0))
        ArrDK(i, 2) = Wf.If(Wf.IsNA(Wf.VLookup(sArray(i, 1), n1, 8, 0)), 0, Wf.VLookup(sArray(i, 1), n1, 8, 0))
    Next i
    Range("D11").Resize(UBound(ArrDK, 2)).Value = ArrDK
End Sub

Nhưng nó cứ báo lỗi, xin chỉ điểm sai!
Tại cột D & E của Sheet CNT01, em có tạo cthức lấy số dư
Em cảm ơn!

WorksheetFunction đâu có hổ trợ hàm IF
Sửa lại:

Sub DauKy()
    Dim i As Long
    Dim ArrDK, sArray, shh [COLOR=#ff0000]As Worksheet[/COLOR]
    Dim n1 As Range
    [COLOR=#ff0000]Dim tmp1, tmp2[/COLOR]
    [COLOR=#ff0000]On Error Resume Next[/COLOR]
    Dim Wf As WorksheetFunction
    Set Wf = WorksheetFunction
    sArray = Range([B11], [B65536].End(3)).Resize(, 8).Value

Set shh = Sheets("CNT00")
    Set n1 = shh.Range(shh.[B11], shh.[B65536].End(3)).Resize(, 8)
    ReDim ArrDK(1 To UBound(sArray, 1), 1 To 2)
    For i = 1 To UBound(sArray, 1)
        [COLOR=#ff0000]tmp1 = Wf.VLookup(sArray(i, 1), n1, 7, 0)
        tmp2 = Wf.VLookup(sArray(i, 1), n1, 8, 0)
        If TypeName(tmp1) = "Double" Then ArrDK(i, 1) = tmp1
        If TypeName(tmp2) = "Double" Then ArrDK(i, 2) = tmp2
    Next i[/COLOR]
    Range("D11").Resize([COLOR=#ff0000]UBound(ArrDK, 1), 2[/COLOR]).Value = ArrDK
End Sub

Bài này dùng Find Method sẽ hay hơn
Làm bài này bằng Find Method nhé:

Sub DauKy()
  Dim i As Long
  Dim arrRes, arrSrc
  Dim n1 As Range, rTmp As Range
  With Sheets("CNT01")
    arrSrc = .Range(.[B11], .[B65536].End(3)).Value
  End With
  With Sheets("CNT00")
    Set n1 = .Range(.[B11], .[B65536].End(3))
  End With
  ReDim arrRes(1 To UBound(arrSrc, 1), 1 To 2)
  For i = 1 To UBound(arrSrc, 1)
    Set rTmp = n1.Find(arrSrc(i, 1), , xlValues, xlWhole)
    If Not rTmp Is Nothing Then
      arrRes(i, 1) = rTmp.Offset(, 6)
      arrRes(i, 2) = rTmp.Offset(, 7)
    End If
  Next i
  Sheets("CNT01").Range("D11").Resize(UBound(arrRes, 1), 2).Value = arrRes
End Sub

Chú ý: Range ở đâu thì phải ghi rõ tên sheet… coi chừng "đứng" tại sheet khác mà chạy code sẽ bị sai.
Bài này còn 1 chiêu nữa dùng toàn Array (không Find cũng không WorksheetFunction…)… Bảo đảm tốc độ sẽ nhanh
Ai đó có hứng thú hãy bắt tay vào làm xem!

www.giaiphapexcel.com/diendan/threads/gi%C3%BAp-s%E1%BB%ADa-code-l%E1%BA%A5y-s%E1%BB%91-d%C6%B0-%C4%91%E1%BA%A7u-k%E1%BB%B3.75567/

Kỹ năng giải quyết vấn đề hiệu quả
Khóa học SprinGO phù hợp

Kỹ năng giải quyết vấn đề hiệu quả

Mô tả Nội dung Đánh giá Tài nguyên KỸ NĂNG GIẢI QUYẾT VẤN ĐỀ HIỆU QUẢHiểu đúng vấn đề là một nửa của giải...

Xem khóa học
★★★★★ 5 ★ 1 👤 1 ▥ 0
Quảng cáo

Bạn nên đọc

Bình luận

Quảng cáo

Cũ vẫn chất

Xem thêm