Andy2483

¦^´_ 1# qaqa3296


    ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
¤£½×¬O§_²Å¦X»Ý¨D! «á¾Ç¦b¦¹©«¾Ç¨ì«Ü¦hª¾ÃÑ!
«á¾Çªº°}¦C»P¦r¨å½m²ß¤ß±oµù¸Ñ¦p¤U:
Option Explicit
Sub TEST_1()
Dim Brr, Arr, c&, R&, V, Y, Z
Dim K$, P$, Q, S
'¡ô«Å§iÅܼÆ
S = Timer
Sheets(3).[M2:P60000].ClearContents
Set Y = CreateObject("Scripting.Dictionary")
Set Z = CreateObject("Scripting.Dictionary")
Set V = CreateObject("Scripting.Dictionary")
'¡ô¥OY,Z,V¦U¬O¦r¨å
Arr = Sheets(1).Range("A1:C" & Sheets(1).[A65536].End(3).Row)
'¡ô¥Ø¼Ðªí °}¦C½d³ò
For R = 1 To UBound(Arr)
'¡ô¥~¶¶°j°é§â ¥Ø¼Ðªí ³W®æ©î¸Ñ,­«²Õ¬°¼Ò½k¤ñ¹ïÃöÁä¦r¨Ã­Ë¤JV¦r¨å
   For c = 1 To UBound(Arr, 2)
   '¡ô¤º¶¶°j°é¥h°£ªÅ¥Õ¦r¤¸
      Arr(R, c) = Replace(Arr(R, c), " ", "")
   Next
   P = Arr(R, 3)
   If P Like "*-*-*" Then
      P = Split(P, "-")(0) & "-" & Split(P, "-")(1)
      ElseIf P = "" Then
      '¡ô¦pªG³W®æÄæ¬OªÅ®æ ´N¥HAÄæ®æ»PBÄæ®æ²Õ¬°¼Ò½k¤ñ¹ïÃöÁä¦r
         P = Arr(R, 1) & Arr(R, 2)
   End If
   V(P) = 1
   '¡ô­Ë¤JV¦r¨å
   P = ""
Next
Brr = Sheets(2).Range("D1:A" & Sheets(2).[A65536].End(3).Row)
'¡ô®w¦sªí °}¦C½d³ò
For R = 1 To UBound(Brr)
'¡ô¥~¶¶°j°é§â ®w¦sªí ³W®æ©î¸Ñ,­«²Õ¦A¥[¤J²Å¸¹ "|" »P¦C¼Æ
',¬°¼Ò½k¤ñ¹ïÃöÁä¦r¨Ã­Ë¤JZ¦r¨å
   For c = 1 To UBound(Brr, 2)
   '¡ô¤º¶¶°j°é¥h°£ªÅ¥Õ¦r¤¸
      Brr(R, c) = Replace(Brr(R, c), " ", "")
      P = P & Brr(R, c) & "|"
     '¡ô§â¨C¦C4Ä檺¸ê®Æ¥Î "|" ¦ê°_¨Ó
   Next
   K = Brr(R, 3)
   If K Like "*-*-*" Then
      K = Split(K, "-")(0) & "-" & Split(K, "-")(1)
      ElseIf K = "" Then
         K = Brr(R, 1) & Brr(R, 2)
   End If
   Z(K & "|" & R) = P  '@@
   '¡ô­«²Õ¦A¥[¤J²Å¸¹ "|" »P¦C¼Æ
   P = ""
Next
For Each Q In Z.KEYS
   If V(Split(Q, "|")(0)) = 1 Then
   '¡ô¥Î "|" ©î¸ÑZ¦r¨å¸Ìªºkey,¦r¦ê¦bV¦r¨å§ä¨ì,¥Nªí²Å¦X´£¨ú±ø¥ó
      Y(Q) = Split(Z(Q), "|")
      '¡ô¥ÎY¦r¨å¸Ë ²Å¦X±ø¥ó ªºZ¦r¨åitem¸ê®Æ  @@³B
   End If
Next
Arr = Application.Transpose(Application.Transpose(Y.items))
'¡ô±NY¦r¨åªº items Âà¸m¨â¦¸ ´N¬Oµ²ªG¸ê®Æ
Sheets(3).[M1].Resize(Y.Count, 4) = Arr
MsgBox Timer - S & "’"
End Sub