Giúp sửa code lấy số dư đầu kỳ! (1 người xem)

[Hong.Van]

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!

 

[ndu96081631]

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[/COLOR][COLOR=#ff0000]), 2[/COLOR]).Value = ArrDK
End Sub

Bài này dùng Find Method sẽ hay hơn

 

[ndu96081631]

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

 

[ndu96081631]

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!

 

[Hong.Van]

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

Em xin cảm ơn Thầy
Trong File của em có nhiều Sheet như CNT00, CNT01, CNT02 .... CNT12, CNT13: hai ký tự sau tên Sheet là tháng: từ 01 -> 12 là tháng 01 đến tháng 12 của năm hiện hành, Riêng tháng CNT00 là tháng 12 của năm trước và T13 là Cả năm hiện hành
Em muốn lấy số dư cuối kỳ của tháng trước để làm đầu kỳ cho tháng sau, ví dụ:
Số dư đầu kỳ CNT01 sẽ lấy số dư cuối kỳ của tháng trước là CNT00 (giống như code củaq Thầy viết trên)
Số dư đầu kỳ CNT02 sẽ lấy số dư cuối kỳ của tháng trước là CNT01
................
Số dư đầu kỳ CNT12 sẽ lấy số dư cuối kỳ của tháng trước là CNT11
RIÊNG CNT13 (cả năm) thì
Số dư đầu kỳ CNT13 sẽ lấy số dư cuối kỳ của tháng trước là CNT00
-----------
Em có áp dụng code của Thầy để viết theo yêu cầu trên, nhưng vẫn báo lỗi (chỗ màu đỏ)

Sub DauKy()    Dim i As Long
    Dim arrRes, arrSrc
    Dim n1 As Range, rTmp As Range
    Dim sM, shName, oldShName As Worksheet
    With ActiveSheet
        arrSrc = .Range(.[B11], .[B65536].End(3)).Value
    End With
    shName = ActiveSheet.Name
    sM = Val(Right(shName, 2))
[COLOR=#ff0000]    Set oldShName = "CNT" & Right("0" & sM - 1, 2)[/COLOR]


    With oldShName
        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
    ActiveSheet.Range("D11").Resize(UBound(arrRes, 1), 2).Value = arrRes
End Sub

----------
Thầy giúp em sửa code trên
Em cảm ơn

 

[ndu96081631]

Em xin cảm ơn Thầy
Trong File của em có nhiều Sheet như CNT00, CNT01, CNT02 .... CNT12, CNT13: hai ký tự sau tên Sheet là tháng: từ 01 -> 12 là tháng 01 đến tháng 12 của năm hiện hành, Riêng tháng CNT00 là tháng 12 của năm trước và T13 là Cả năm hiện hành
Em muốn lấy số dư cuối kỳ của tháng trước để làm đầu kỳ cho tháng sau, ví dụ:
Số dư đầu kỳ CNT01 sẽ lấy số dư cuối kỳ của tháng trước là CNT00 (giống như code củaq Thầy viết trên)
Số dư đầu kỳ CNT02 sẽ lấy số dư cuối kỳ của tháng trước là CNT01
................
Số dư đầu kỳ CNT12 sẽ lấy số dư cuối kỳ của tháng trước là CNT11
RIÊNG CNT13 (cả năm) thì
Số dư đầu kỳ CNT13 sẽ lấy số dư cuối kỳ của tháng trước là CNT00
-----------
Em có áp dụng code của Thầy để viết theo yêu cầu trên, nhưng vẫn báo lỗi (chỗ màu đỏ)

Sub DauKy()    Dim i As Long
    
    shName = ActiveSheet.Name
    sM = Val(Right(shName, 2))
[COLOR=#ff0000]    Set oldShName = "CNT" & Right("0" & sM - 1, 2)[/COLOR]


    
End Sub

----------
Thầy giúp em sửa code trên
Em cảm ơn

Thằng em này "CNT" & Right("0" & sM - 1, 2) là Text mà, sao dùng Set được
Vầy mới đúng: Set oldShName = Sheets("CNT" & Format(sM, "00"))

 

[thanhlanh]

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!

Đẩy hết tất cả các Sheet vào mảng luôn:

Sub DauKy()
    Dim i1 As Long, i2 As Long, i As Long, j, k
    Dim arrDauky(), arrCuoiky()
    For i = 0 To 12
        k = i: j = k + 1
        If j = 13 Then k = 0
        k = CStr(IIf(Len(k) = 1, "0" & k, k))
        j = CStr(IIf(Len(j) = 1, "0" & j, j))
        With Sheets("CNT" & k)
            arrCuoiky = .Range(.[B11], .[B65536].End(3)).Resize(, 8).Value
        End With
        With Sheets("CNT" & j)
            arrDauky = .Range(.[B11], .[B65536].End(3)).Resize(, 4).Value
        End With
        For i1 = 1 To UBound(arrDauky, 1)
            For i2 = 1 To UBound(arrCuoiky, 1)
                If Abs(arrCuoiky(i2, 7)) + Abs(arrCuoiky(i2, 8)) > 0 Then
                    If Trim(arrCuoiky(i2, 1)) = Trim(arrDauky(i1, 1)) Then
                        arrDauky(i1, 3) = arrCuoiky(i2, 7)
                        arrDauky(i1, 4) = arrCuoiky(i2, 8)
                    End If
                End If
            Next
        Next
        Sheets("CNT" & j).Range("B11").Resize(UBound(arrDauky, 1), 4).Value = arrDauky
    Next
End Sub