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

Chia sẻ bởi:hands
★★★★★
‹ Giúp sửa code: Tính tổng cho từng... Nhờ viết code đối chiếu so sánh... ›
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
‹ Giúp sửa code: Tính tổng cho từng nhóm Nhờ viết code đối chiếu so sánh cho... ›
Quảng cáo

Bạn nên đọc

One Response

  1. hands says:
    20/12/2022 at 5:04 pm

    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

    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"))

    Đẩ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
    Reply

Leave a Reply

Your email address will not be published. Required fields are marked *

Quảng cáo
▣ Excel Ứng Dụng

Cũ vẫn chất

Giúp sửa code: Tính tổng cho từng nhóm Giúp sửa code: Tính tổng cho từng nhóm Giúp sửa code: dựa vào sheet khác, tính tổng cho từng nhóm (giống SumProduct) Giúp sửa code: dựa vào sheet khác, tính tổng cho từng nhóm (giống SumProduct) Giúp sửa code: hàm Month và nối chuỗi Giúp sửa code: hàm Month và nối chuỗi Giúp viết code dò tìm và nối chuỗi Giúp viết code dò tìm và nối chuỗi Giúp sửa code: Dùng Find Method để lấy dữ liệu ở nhiều Sheet khác nhau theo ĐK! Giúp sửa code: Dùng Find Method để lấy dữ liệu ở nhiều Sheet khác nhau theo ĐK! Giúp viết code: Cộng dồn, trừ dồn đến hàng tương ứng. Giúp viết code: Cộng dồn, trừ dồn đến hàng tương ứng.

Xem thêm