- ©«¤l
- 1446
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1470
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-11-28
|
ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð
°õ¦æ«e:
°õ¦æµ²ªG:
Option Explicit
Sub TEST()
Dim Brr, Crr, Z, i&, R&, Y$, N&, J&, V&, T$, xA As Range
'¡ô«Å§iÅܼÆ
Set Z = CreateObject("Scripting.Dictionary")
'¡ô¥OZÅܼƬO ¦r¨å
Set xA = Range([H1], [A65536].End(3)): Brr = xA
'¡ô¥OxAÅܼƬO «ü©w½d³òÀx¦s®æ(ª«¥ó),¥OBrrÅܼƬO¼g¤JxAÅܼÆ(Àx¦s®æ)Ȫº¤Gºû°}¦C
ReDim Crr(1 To 1000, 1 To 3)
'¡ô«Å§iCrrÅܼƬO ¤GºûªÅ°}¦C,¯Á¤Þ¸¹~1000¦C,1~3Äæ
For i = 2 To UBound(Brr)
'¡ô³]¶¶°j°é!i±q2 ¨ìBrr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
Y = Format(Brr(i, 1), "YYYY"): If Y = "" Then GoTo i01 Else R = Z(Y)
'¡ô¥OYÅܼƬO¤é´Áªº4½X¦~¥÷¦r¦ê,¦pªGYÅܼƬO ªÅ¦r¤¸,´N¸õ¨ì¼Ð¥Ü i01¦ì¸mÄ~Äò°õ¦æ,
'§_«h´N¥ORÅܼƬO¥HYÅܼƬdZ¦r¨å¦^¶ÇitemÈ
If R = 0 Then N = N + 1: R = N: Z(Y) = R: Brr(R, 1) = Y: Brr(R, 2) = "¦~«×¤pp": Brr(R, 3) = 0
'¡ô¦pªG¦¹¦~¤À¬Oº¦¸¯Ç¤JZ¦r¨å!´N¥ON²Ö¿nBrr°}¦C©ñµ²ªG¦C¼Æ,
'¥H¦~¤À¬°key,item¬O¦C¸¹,¯Ç¤JZ¦r¨å,
'¥OBrr°}¦Cµ²ªG¦C²Ä2Äæ°}¦CȬO "¦~«×¤pp"¦r¦ê,¥Oì¨ÓBrr°}¦C¸ê®Æȳ]¬°0
Brr(R, 3) = Brr(R, 3) + Val(Brr(i, 8))
'¡ô¥OBrr°}¦Cµ²ªG¦C²Ä3Äæ²Ö¥[ ª÷ÃB
T = Trim(Brr(i, 3)): If T = "" Then GoTo i01 Else V = Z(T)
'¡ô¥OTÅܼƬO ªÑ²¼¦WºÙ¦r¦ê,¦pªGTÅܼƬO ªÅ¦r¤¸,´N¸õ¨ì¼Ð¥Ü i01¦ì¸mÄ~Äò°õ¦æ,
'§_«h´N¥OVÅܼƬO¥HTÅܼƬdZ¦r¨å¦^¶ÇitemÈ
If V = 0 Then J = J + 1: V = J: Z(T) = V: Crr(V, 1) = T: Crr(V, 2) = "¾ú¥vÁ`p"
'¡ô¦pªGªÑ²¼¦WºÙ¬Oº¦¸¯Ç¤JZ¦r¨å!´N¥OJ²Ö¿nCrr°}¦C©ñµ²ªG¦C¼Æ,
'¥HªÑ²¼¦WºÙ¬°key,item¬O¦C¸¹,¯Ç¤JZ¦r¨å,
'¥OCrr°}¦Cµ²ªG¦C²Ä2Äæ°}¦CȬO "¾ú¥vÁ`p"¦r¦ê
Crr(V, 3) = Crr(V, 3) + Val(Brr(i, 8))
'¡ô¥OCrr°}¦Cµ²ªG¦C²Ä3Äæ²Ö¥[ ª÷ÃB
i01: Next
ActiveSheet.UsedRange.Offset(xA.Rows.Count).ClearContents
'¡ô¥Oªºµ²ªG¦C²M°£¤º®e
If N = 0 Then Exit Sub
'¡ô¦pªG¦~¤À²Îp¨S¦³¸ê®Æ!´Nµ²§ôµ{¦¡°õ¦æ
xA(xA.Count + 6).Resize(N, 3) = Brr
'¡ô¥O¦~¤À²Îp¸ê®Æ¼g¤JÀx¦s®æ
If J = 0 Then Exit Sub
'¡ô¦pªGªÑ²¼¦WºÙ¾ú¥vÁ`p¨S¦³¸ê®Æ!´Nµ²§ôµ{¦¡°õ¦æ
[A65536].End(3)(N + 3, 6).Resize(J, 3) = Crr
'¡ô¥OªÑ²¼¦WºÙ¾ú¥vÁ`p²Îp¸ê®Æ¼g¤JÀx¦s®æ
End Sub |
|