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

[µo°Ý] ª½¦¡§ï¾î¦¡·j´Mªº¤½¦¡

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-5-31 10:28 ½s¿è

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ßVBA°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð

°õ¦æµ²ªG:



Option Explicit
Sub TEST()
Dim Brr, Crr, Y, j%, T$, T1$, R%
'¡ô«Å§iÅܼÆ
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OYÅܼƬO ¦r¨å
Brr = Range([B5], Cells(1, Columns.Count).End(1))
'¡ô¥OBrrÅܼƬO¤Gºû°}¦C,¥H1~5¦C¸ê®Æ±a¤J°}¦C¤¤(¤£¥]§t¼ÐÃDÄæ»PªÅÄæ)
ReDim Crr(1 To UBound(Brr, 2), 1 To 2)
'¡ô¥OCrrÅܼƬO ¤GºûªÅ°}¦C,Áa¦V¦PBrr¾î¦V½d³ò,¾î¦V1~2
For j = 1 To UBound(Brr, 2)
'¡ô³]¶¶°j°é
   T = Brr(4, j): T1 = Brr(2, j)
   '¡ô¥OTÅܼƬO ²Ä4¦C°}¦C­È,¥OT1ÅܼƬO ²Ä2¦C°}¦C­È
   If Y(T) = "" Then R = R + 1: Y(T) = R: Crr(R, 1) = T: Crr(R, 2) = T1: GoTo j01
   '¡ô¦pªGTÅܼƬO²Ä1¦¸¯Ç¤JY¦r¨å,´N¥ORÅܼƲ֥[1(¬ö¿ý¦C¸¹),
   '¥OTÅܼƦbY¦r¨å¸Ìªºitem("")´«¦¨RÅܼÆ,
   '¥OCrr°}¦C²Ä1Äæ©ñ ¼Æ¶q,¥OCrr°}¦C²Ä2Äæ©ñ ²Ä1­Ó½c¸¹
   '¸õ¨ì¼Ð¥Üj01¦ì¸mÄ~Äò°õ¦æ

   Crr(Y(T), 2) = Crr(Y(T), 2) & "," & T1
   '¡ôµ{§Ç·|¶]¨ì³o¦ì¸m!³£¬O²Ä2¦¸¥H¤W¥X²{ªºkey,
   '¥OCrr°}¦C²Ä2ÄæÄ~Äò²Ö¿n½c¸¹,¥H³r¸¹¹j¶}

j01: Next
[I8:J8] = [{"¼Æ¶q","½c¸¹"}]: [I9].Resize(R, 2) = Crr
'¡ô¥OÀx¦s®æ²Ä8¦C¬O¼ÐÃD¦C,¥OCrr°}¦C±q[I9]¶}©l¼g¤JÀx¦s®æ¸Ì
Set Y = Nothing: Erase Brr, Crr
'¡ô¥OÄÀ©ñÅܼÆ
End Sub


'===================================================
'¼ÐÃDÄæ°j°é¤¤³B²zªº¤è®×


Option Explicit
Sub TEST_1()
Dim Brr, Crr, Y, j%, T$, T1$, R%
Set Y = CreateObject("Scripting.Dictionary")
Brr = Range([A5], Cells(1, Columns.Count).End(1))
ReDim Crr(1 To UBound(Brr, 2), 1 To 2)
For j = 1 To UBound(Brr, 2)
   T = Brr(4, j): T1 = Brr(2, j)
   If Y(T) = "" Then R = R + 1: Y(T) = R: Crr(R, 1) = T: Crr(R, 2) = T1: GoTo j01
   Crr(Y(T), 2) = Crr(Y(T), 2) & "," & T1
j01: Next
[I8].Resize(R, 2) = Crr
Set Y = Nothing: Erase Brr, Crr
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : ¦h°µ¦h±o¡C¤Ö°µ¦h¥¢¡C
ªð¦^¦Cªí ¤W¤@¥DÃD