ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

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

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

¥»©«³Ì«á¥Ñ cdcc ©ó 2011-5-15 22:49 ½s¿è

±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ºØ±ø¥ó, ¤~¯à¦¨¬°¤@²Õ.

ÁÂÁÂÀ°¦£

SAMPLE.rar (4.32 KB)

¦^´_ 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

TOP

¦^´_ 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Á¦^ÂÐ

TOP

¦^´_ 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

TOP

¦^´_ 5# ¦Ñ®L


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

TOP

¦^´_ 4# GBKEE


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

ÁÂÁÂ

TOP

  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
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

        ÀR«ä¦Û¦b : ¦³Ä@©ñ¦b¤ß¸Ì¡A¨S¦³¨­Åé¤O¦æ¡A¥¿¦p¯Ñ¥Ð¤£¼½ºØ¡A¬Ò¬OªÅ¹L¦]½t¡C
ªð¦^¦Cªí ¤W¤@¥DÃD