[µo°Ý] Debtor aging report - Sub total

cdcc

±NDATA¤ÀÃþ, »s¦¨Debtor aging report

±ø¥ó:
1)Customer ID
2)Currency
3)Remark - <30 OR >=30

¨C¤@²Õ³£­n¦³SUB TOTAL AMOUNT

®æ¦¡¤è­±:
1) SUB TOTAL(¤å¦r) ­n¦bCOLUMN E¥X²{
2) SUB TOTAL ¤§¤U»Ý­n¦³¤@¦æªÅ¥ÕªºROW
3)SUB TOTAL AMOUNT­n¦³®Ø½u

¥X¨Óªº®ÄªG´N¦n¹³¤â°Ê¤@¯ë, (¸ê®Æ-->¤p­p-->¤À²Õ¤pÄæ¦ì).
¦ý»Ý­n²Å¦X¤TºØ±ø¥ó, ¤~¯à¦¨¬°¤@²Õ.

ÁÂÁÂÀ°¦£

GBKEE

¦^´_ 1# cdcc

1. Sub Ex1()
   
2.     Dim i%, Rng As Range
   
3.     With Sheet1
   
4.          '1 ¿z¿ï
   
5.          Range("A4").Sort Key1:=Range("E5"), Order1:=xlAscending, Key2:=Range("A5"), Order2:=xlAscending, Header:=xlYes
   
6.         i = 5
   
7.         Do While .Cells(i, "A").End(xlDown).Row <> Rows.Count
   
8.             If .Cells(i, "A") & .Cells(i, "A") <> "" And .Cells(i + 1, "A") & .Cells(i + 1, "A") <> "" Then
   
9.                 If .Cells(i, "A") & .Cells(i, "A") <> .Cells(i + 1, "A") & .Cells(i + 1, "A") Then
   
10.                     i = i + 1
    
11.                     Set Rng = .Range(.Cells(i, "A"), .Cells(Rows.Count, "G").End(xlUp))
    
12.                     '2 ²¾°Ê½d³ò
    
13.                     Rng.Cut Rng.Offset(2)
    
14.                     i = i + 1
    
15.                 End If
    
16.             End If
    
17.             i = i + 1
    
18.         Loop
    
19.         Set Rng = .Range("G5", .Cells(Rows.Count, "G").End(xlUp))
    
20.         For Each E In Rng.SpecialCells(xlCellTypeConstants).Areas
    
21.             E(E.Count + 1, 0).Value = "Sub Total:"
    
22.             '3 µ¹­È
    
23.             With E(E.Count + 1)
    
24.                 .Value = Application.Sum(E)
    
25.                 .Borders(3).LineStyle = 1
    
26.                 .Borders(3).Weight = 2
    
27.                 .Borders(4).LineStyle = 1
    
28.                 .Borders(4).Weight = 3
    
29.             End With
    
30.         Next
    
31.     End With
    
32.     Set Rng = Nothing
    
33. End Sub

½Æ»s¥N½X

1. Sub Ex2()   '°}¦C¤è¦¡
   
2.     Dim D As Object, Rng As Range, R, AR
   
3.     Set D = CreateObject("Scripting.dictionary")
   
4.     With Sheet1
   
5.          Range("A4").Sort Key1:=Range("E5"), Order1:=xlAscending, Key2:=Range("A5"), Order2:=xlAscending, Header:=xlYes
   
6.         Set Rng = .Range(.[a5], .[a5].End(xlToRight).End(xlDown))
   
7.     End With
   
8.     For Each R In Rng.Rows
   
9.         If D.Exists(R.Cells(1, 1) & R.Cells(1, 5)) Then
   
10.             AR = D(R.Cells(1, 1) & R.Cells(1, 5))
    
11.             ReDim Preserve AR(1 To UBound(AR), 1 To UBound(AR, 2) + 1)
    
12.             For i = 1 To UBound(AR)
    
13.                 AR(i, UBound(AR, 2)) = R.Cells(i)
    
14.             Next
    
15.             D(R.Cells(1, 1) & R.Cells(1, 5)) = AR
    
16.         Else
    
17.             D(R.Cells(1, 1) & R.Cells(1, 5)) = Application.Transpose(R.Value)
    
18.         End If
    
19.     Next
    
20.     With Sheet1
    
21.          .Range(.[a5], .Cells(Rows.Count, "G")).Clear
    
22.          Set Rng = .[a5]
    
23.     End With
    
24.     For Each R In D.KEYS
    
25.         Rng.Resize(UBound(D(R), 2), 7) = Application.Transpose(D(R))
    
26.         With Rng.Cells(UBound(D(R), 2) + 1, 5)
    
27.             .Value = "Sub Total:"
    
28.             With .Offset(, 1)
    
29.                 .Value = Application.Sum(Application.Index(D(R), 6))
    
30.                 .Borders(3).LineStyle = xlContinuous
    
31.                 .Borders(3).Weight = xlThin
    
32.                 .Borders(4).LineStyle = xlContinuous
    
33.                 .Borders(4).Weight = 3
    
34.             End With
    
35.         End With
    
36.         Set Rng = Rng.Cells(1).Offset(UBound(D(R), 2) + 2)
    
37.      Next
    
38.     Set D = Nothing
    
39.     Set Rng = Nothing
    
40. End Sub

½Æ»s¥N½X

cdcc

¦^´_ 3# GBKEE


ÁÂÁ¦^ÂÐ

    ±ø¥ó:
1)Customer ID
2)Currency
3)­×¥¿ Remark À³¸Ó - <=30 OR >30 ¨âÃþ§O, ¨ä¹ê¬O¥Nªí over due period

¦ý­º¥ýCustomer ID»Ý­n ¥Ñ¤p¦Ü¤j¶¶§ÇÅã¥Ü
¨ä¦¸¬OCurrency
³Ì«á¬O Remark

²Å¦X©Ò¦³±ø¥ó, ¤~¦¨¬°¤@¤p²ÕÃþ§O

·PÁ¦^ÂÐ

GBKEE

¦^´_ 4# cdcc
3)­×¥¿ Remark À³¸Ó - <=30 OR >30 ¨âÃþ§O, ¨ä¹ê¬O¥Nªí over due period
±ø¥ó­n¤@¦¸»¡²M·¡,Áö¦³½d¨Ò¤]­n»¡¥X­«ÂI

1. Sub Ex2()   '°}¦C¤è¦¡
   
2.     Dim D As Object, Rng As Range, R, AR, Msg As Boolean
   
3.     Set D = CreateObject("Scripting.dictionary")
   
4.     With Sheet1
   
5.         .Range("A4").Sort Key1:=.Range("A5"), Order1:=xlAscending, Key2:=.Range("E5"), Order2:=xlAscending, Key3:=.Range("G5"), Order3:=xlAscending, Header:=xlYes
   
6.         Set Rng = .Range(.[a5], .[a5].End(xlToRight).End(xlDown))
   
7.     End With
   
8.     For Each R In Rng.Rows
   
9.         Msg = IIf(R.Cells(1, 7) <= 30, True, False)
   
10.         If D.Exists(R.Cells(1, 1) & R.Cells(1, 5) & Msg) Then
    
11.             AR = D(R.Cells(1, 1) & R.Cells(1, 5) & Msg)
    
12.             ReDim Preserve AR(1 To UBound(AR), 1 To UBound(AR, 2) + 1)
    
13.             For i = 1 To UBound(AR)
    
14.                 AR(i, UBound(AR, 2)) = R.Cells(i)
    
15.             Next
    
16.             D(R.Cells(1, 1) & R.Cells(1, 5) & Msg) = AR
    
17.         Else
    
18.             D(R.Cells(1, 1) & R.Cells(1, 5) & Msg) = Application.Transpose(R.Value)
    
19.         End If
    
20.     Next
    
21.     With Sheet1
    
22.          .Range(.[a5], .Cells(Rows.Count, "G")).Clear
    
23.          Set Rng = .[a5]
    
24.     End With
    
25.     For Each R In D.KEYS
    
26.         Rng.Resize(UBound(D(R), 2), 7) = Application.Transpose(D(R))
    
27.         
    
28.         With Rng.Cells(UBound(D(R), 2) + 1, 5)
    
29.             .Value = "Sub Total:"
    
30.             With .Offset(, 1)
    
31.                 .Value = Application.Sum(Application.Index(D(R), 6))
    
32.                 .Borders(3).LineStyle = xlContinuous
    
33.                 .Borders(3).Weight = xlThin
    
34.                 .Borders(4).LineStyle = xlContinuous
    
35.                 .Borders(4).Weight = 3
    
36.             End With
    
37.         End With
    
38.         Set Rng = Rng.Cells(1).Offset(UBound(D(R), 2) + 2)
    
39.      Next
    
40.     Set D = Nothing
    
41.     Set Rng = Nothing
    
42. End Sub

½Æ»s¥N½X

cdcc

¦^´_ 5# ¦Ñ®L


    ªº½T¬O¦h¤F¨âµ§°O¿ý.
    ÁÂÁ´£ÂI, «ü¥X¿ù³B.
    ¤U¦¸·|¨Ì³W­×¥¿«á¤~´£°Ý.

cdcc

¦^´_ 4# GBKEE


    OK!!
   ¯uªº«Ü¤è«K, ¥i¥H«Ü§Ö§¹¦¨.
  §Ú¬Oªì¾ÇªÌ, »Ý­n®É¶¡¤F¸Ñ©Ò¼gªºVBA¤º®e.
  ¦pªG§Ú¦³¤£©ú¥Õ, §Æ±æ¤é«á¥i¥H¸Ô¥[¸ÑÄÀ

ÁÂÁÂ

Hsieh

1. Sub nn()
   
2. Set d = CreateObject("Scripting.dictionary")
   
3. Set d1 = CreateObject("Scripting.dictionary")
   
4. Dim Ar()
   
5. Range("A4").CurrentRegion.Sort key1:=[A5], Header:=xlYes
   
6. A = [A4].CurrentRegion.Offset(1)
   
7. For i = 1 To UBound(A)
   
8. If IsEmpty(d(A(i, 1) & A(i, 5))) Then
   
9.     d(A(i, 1) & A(i, 5)) = Array(Application.Index(A, i))
   
10.     d1(A(i, 1) & A(i, 5)) = d1(A(i, 1) & A(i, 5)) + 1
    
11.     Else
    
12.     Ar = d(A(i, 1) & A(i, 5))
    
13.     ReDim Preserve Ar(d1(A(i, 1) & A(i, 5)))
    
14.     Ar(d1(A(i, 1) & A(i, 5))) = Array(Application.Index(A, i))
    
15.     d(A(i, 1) & A(i, 5)) = Ar
    
16.     d1(A(i, 1) & A(i, 5)) = d1(A(i, 1) & A(i, 5)) + 1
    
17.   End If
    
18. Next
    
19. r = 5
    
20. [A4].CurrentRegion.Offset(1) = ""
    
21. For Each ky In d.keys
    
22. If ky <> "" Then
    
23.    Cells(r, 1).Resize(UBound(d(ky)) + 1, 7) = Application.Transpose(Application.Transpose(d(ky)))
    
24.    Cells(r + UBound(d(ky)) + 1, 5) = "Sub Total:"
    
25.    Cells(r + UBound(d(ky)) + 1, 6) = Application.Sum(Application.Index(d(ky), , 6))
    
26.    r = r + UBound(d(ky)) + 3
    
27. End If
    
28. Next
    
29. End Su

½Æ»s¥N½X