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

Liên hệ QC

Người dùng đang xem chủ đề này

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
36
Được thích
5
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!
 
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

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

Bài viết mới nhất

Back
Top Bottom