Lưu kết quả trong biến tạm của vòng lặp 2 chiều

Liên hệ QC
Tôi tuân thủ nội quy khi đăng bài

hieuvietmy2020

Thành viên mới
Tham gia
18/4/20
Bài viết
18
Được thích
1
Em xin chào Anh Chị,
Em có viết 1 đoạn code để tính Phí/m2 và cập nhật tình hình đã thu công nợ theo tháng ở Sheet "CD" (Theo file đính kèm)

Phí theo tháng = Số m2 (Sheet CCH) x 12.100đ/1m2

Em đang bị vướng ở đoạn With shNKC .... End With, kết quả trả về đang là giống nhau ở cuối vòng lặp j (Cụ thể là mã ALR_2202)
Nhờ anh Chị hướng dẫn giúp em cách điều chỉnh đoạn code trên.
Em chân thành cảm ơn!
 
Em xin đính kèm file ạ!
Nhờ Anh Chị hướng dẫn giúp em.
 

File đính kèm

  • vba0.xlsb
    188.3 KB · Đọc: 5
Upvote 0
Mình cũng đang ở trong BQT của 1 chung cư nên thấy vụ này cũng hay hay
Có vấn đề cần hỏi:
Trong sheet NKC có phát sinh phải thu (PQL, nước + khác), và đã thu tương ứng
Phần phải thu PQL đã có (từ T1-T6) nhưng phần đã thu lại từ T7-T12?
Phần phải thu PQL có cần phải tính lại (đơn giá * số m2 tại sheet CCH) hay không, hay lấy từ NKC là đủ?
 
Upvote 0
Mình cũng đang ở trong BQT của 1 chung cư nên thấy vụ này cũng hay hay
Có vấn đề cần hỏi:
Trong sheet NKC có phát sinh phải thu (PQL, nước + khác), và đã thu tương ứng
Phần phải thu PQL đã có (từ T1-T6) nhưng phần đã thu lại từ T7-T12?
Phần phải thu PQL có cần phải tính lại (đơn giá * số m2 tại sheet CCH) hay không, hay lấy từ NKC là đủ?
Em chào Anh,
1. Thực tế bên em tiếp nhận từ T7 trở đi, nên từ T1-T6 chỉ nhập liệu để theo dõi tách biệt
2. Tại Sheet CD, tính đúng như sau ạ:
Phí quản lý = Số m2 (Sheet CCH) x 12.100đ/1m2 - Khoản đã thu tương ứng bên sheet NKC
P/S: Nếu sheet NKC chưa có nhập liệu thu tiền thì Sheet CD sẽ hiện đúng số tiền m2x12.100đ
 
Upvote 0
Làm đại nhé, sai tính tiếp

PHP:
Option Explicit
Sub congno()
Dim lr&, i&, j&, t&, rng, rng2, ch, thang, res()
Dim dic As Object
Set dic = CreateObject("Scripting.dictionary")
Const dg = 12100

'Tao dic voi key la ma CH, item la phi QL
With Sheets("CCH")
    lr = .Cells(Rows.Count, "B").End(xlUp).Row
    rng = .Range("B5:W" & lr).Value
    For i = 1 To UBound(rng)
        If rng(i, 22) > 0 Then
            If Not dic.exists(rng(i, 1)) Then dic.Add rng(i, 1), rng(i, 22) * dg
        End If
    Next
End With

'copy phi QL vao thang tuong ung (7-11/2023), sau do luu vao rng
With Sheets("CD")
    .Range("Q9:Y518").ClearContents
    ch = .Range("D9:D518").Value
    thang = .Range("Q6:Y6").Value
    rng = .Range("Q9:Y518").Value
    For i = 1 To UBound(ch)
        If dic.exists(ch(i, 1)) Then
            For j = 1 To 9 Step 2
                rng(i, j) = dic(ch(i, 1))
            Next
        End If
    Next
    .Range("Q9:Y518").Value = rng
    rng = .Range("Q9:Y518").Value
End With

'Duyet qua tung dong trong NKC, tru phi QL cua tung thang, tung CH
With Sheets("NKC")
    lr = .Cells(Rows.Count, "B").End(xlUp).Row
    rng2 = .Range("E8:M" & lr).Value
    For i = 1 To UBound(rng2) ' duyet tung dong trong NKC
        If UCase(rng2(i, 1)) Like "THU PQL*" Then
            For j = 1 To UBound(rng) ' duyet tung dong trong CD
                If rng2(i, 9) = ch(j, 1) Then ' duyet tung cot trong CD
                    For t = 1 To 9 Step 2
                        If rng2(i, 1) = "Thu " & thang(1, t) Then
                            rng(j, t) = rng(j, t) - rng2(i, 8) ' phai thu - da thu
                            GoTo Z ' thoat vong lap
                        End If
                    Next
                End If
            Next
        End If
Z:
    Next
End With
With Sheets("CD")
    .Range("Q9:Y518").Value = rng
End With
End Sub
 

File đính kèm

  • vba0.xlsb
    194.8 KB · Đọc: 8
Upvote 0
Làm đại nhé, sai tính tiếp

PHP:
Option Explicit
Sub congno()
Dim lr&, i&, j&, t&, rng, rng2, ch, thang, res()
Dim dic As Object
Set dic = CreateObject("Scripting.dictionary")
Const dg = 12100

'Tao dic voi key la ma CH, item la phi QL
With Sheets("CCH")
    lr = .Cells(Rows.Count, "B").End(xlUp).Row
    rng = .Range("B5:W" & lr).Value
    For i = 1 To UBound(rng)
        If rng(i, 22) > 0 Then
            If Not dic.exists(rng(i, 1)) Then dic.Add rng(i, 1), rng(i, 22) * dg
        End If
    Next
End With

'copy phi QL vao thang tuong ung (7-11/2023), sau do luu vao rng
With Sheets("CD")
    .Range("Q9:Y518").ClearContents
    ch = .Range("D9:D518").Value
    thang = .Range("Q6:Y6").Value
    rng = .Range("Q9:Y518").Value
    For i = 1 To UBound(ch)
        If dic.exists(ch(i, 1)) Then
            For j = 1 To 9 Step 2
                rng(i, j) = dic(ch(i, 1))
            Next
        End If
    Next
    .Range("Q9:Y518").Value = rng
    rng = .Range("Q9:Y518").Value
End With

'Duyet qua tung dong trong NKC, tru phi QL cua tung thang, tung CH
With Sheets("NKC")
    lr = .Cells(Rows.Count, "B").End(xlUp).Row
    rng2 = .Range("E8:M" & lr).Value
    For i = 1 To UBound(rng2) ' duyet tung dong trong NKC
        If UCase(rng2(i, 1)) Like "THU PQL*" Then
            For j = 1 To UBound(rng) ' duyet tung dong trong CD
                If rng2(i, 9) = ch(j, 1) Then ' duyet tung cot trong CD
                    For t = 1 To 9 Step 2
                        If rng2(i, 1) = "Thu " & thang(1, t) Then
                            rng(j, t) = rng(j, t) - rng2(i, 8) ' phai thu - da thu
                            GoTo Z ' thoat vong lap
                        End If
                    Next
                End If
            Next
        End If
Z:
    Next
End With
With Sheets("CD")
    .Range("Q9:Y518").Value = rng
End With
End Sub
Em cảm ơn Anh, code đã hoạt động đúng ạ!
 
Upvote 0
Web KT
Back
Top Bottom