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

[µo°Ý] ½Ð±Ð¡G¥|­Ó±ø¥ó¤Uªº²Ö­p

¦^´_ 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
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : ¡i¥Í©R¦b©I§l¶¡¡j¦òªû»¡¡G¡u¥Í©R¦b©I§l¶¡¡C¡v¤HµLªkºÞ¦í¦Û¤vªº¥Í©R¡A§óµLªk¾×¦í¦º´Á¡AÅý¦Û¤v¥Ã¦í¤H¶¡¡C¬JµM¥Í©R¥h¨Ó³o»òµL±`¡A§Ú­Ì§óÀ³¸Ó¦n¦n¦a·R±¤¥¦¡B§Q¥Î¥¦¡B¥R¹ê¥¦¡AÅý³oµL±`¡BÄ_¶Qªº¥Í©R¡A´²µo¥¦¯uµ½¬üªº¥ú½÷¡A¬M·Ó¥X¥Í©R¯u¥¿ªº»ù­È¡C
ªð¦^¦Cªí ¤W¤@¥DÃD