- ©«¤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-10-21
|
¦^´_ 8# storylai
ÁÂÁ½׾Â,ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨ÒÀÉ
«á¾ÇÂǦ¹¥DÃD½m²ß°}¦C»P¦r¨å,¹B¥Îkey¼Æ¶q¬°«ü©w·sµ²ªG¸ê®Æ¦b°}¦Cªº¦C¦ì¸m
¥H¤U¬O«á¾Ç¾Ç²ß¤è®×,½Ð«e½ú°Ñ¦Ò
°õ¦æ«e:
°õ¦æµ²ªG:
Option Explicit
Sub TEST()
Dim Brr, T, Y, xR, i&, N&, j%
'¡ô«Å§iÅܼÆ:(Brr,T,Y,xR)¬O³q¥Î«¬ÅܼÆ,(i,N)¬Oªø¾ã¼ÆÅܼÆ,j¬Oµu¾ã¼ÆÅܼÆ
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OY³o³q¥Î«¬ÅܼƬO ¦r¨å
Set xR = Range([F1], Cells(Rows.Count, 1).End(3)): Brr = xR
'¡ô¥OxR³o³q¥Î«¬ÅܼƬO [F1]¨ìAÄæ³Ì«á¦³¤º®eÀx¦s®æ,
'¥OBrr³o³q¥Î«¬ÅܼƬO ¤Gºû°}¦C,¥HxRÅܼÆȱa¤J°}¦C¸Ì
For i = 2 To UBound(Brr)
'¡ô³]¶¶°j°é!i±q2¨ì Brr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
For j = 1 To 5: T = T & "|" & Brr(i, j): Next
'¡ô³]¶¶°j°é!j±q1¨ì 5:¥OT³o³q¥Î«¬ÅܼƬO ¦Û¨³s±µ"|" ¦A³s±µ
'i°j°é¦Cj°j°éÄæBrr°}¦CȤ§«áªº·s¦r¦ê
If Y(T) = "" Then
'¡ô¦pªG¥HTÅܼƬdY¦r¨åªºitemȬO ªÅ¦r¤¸??
Y(T) = Y.Count + 1: N = Y(T)
'¡ô¥O¥HTÅܼƬ°key,item¬O Y¦r¨åkey¼Æ¶q+1ªº¼ÆÈ,
'¥ON³oªø¾ã¼ÆÅܼƬO TÅܼƬdY¦r¨åªºitemÈ
For j = 1 To 6: Brr(N, j) = Brr(i, j): Next
'¡ô³]¶¶°j°é!j±q1¨ì 6:¥ONÅܼƦC²ÄjÅܼÆÄæBrr°}¦CȬO
'iÅܼƦC²ÄjÅܼÆÄæBrr°}¦CÈ
Else
N = Y(T): Brr(N, 6) = Brr(N, 6) + Brr(i, 6)
'¡ô¥ON³oªø¾ã¼ÆÅܼƬO TÅܼƬdY¦r¨åªºitemÈ,
'NÅܼƦC²Ä6ÄæBrr°}¦CȬO¦Û¨ + iÅܼƦC²Ä6ÄæBrr°}¦CÈ
End If
T = ""
'¡ô¥OTÅܼƬOªÅ¦r¤¸
Next
With xR.Offset(0, 8).Resize(Y.Count + 1, 6)
'¡ô¥H¤U¬OÃö©óxRÅܼƦV¥k°¾²¾8Äæ«á±q²Ä1®æÂX®i,
'ÂX®i¦V¤UY¦r¨åkey¼Æ¶q+1¦C,¦V¥kÂX®i6Äæ,Ãö©ó¦¹½d³òÀx¦s®æµ{§Ç
.EntireColumn.ClearContents
'¡ô¥O³o¨ÇÀx¦s®æ©Ò¦bªºÄæ¦ìÀx¦s®æȲMªÅ
.Value = Brr
'¡ô¥O³o¨ÇÀx¦s®æÈ¥HBrr°}¦Cȱa¤J
End With
Set Y = Nothing: Set xR = Nothing: Erase Brr
'¡ôÄÀ©ñÅܼÆ
End Sub |
|