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

§ä¥X«ü©w¤H¼Æ

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-5-12 14:20 ½s¿è

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

°õ¦æ«e:


°õ¦æµ²ªG:



Option Explicit
Sub TEST()
Dim Brr, Crr, Y, N&, i&, j&
'¡ô«Å§iÅܼÆ
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OYÅܼƬO ¦r¨å
Brr = Range([C1], Cells(Rows.Count, 1).End(3))
'¡ô¥OBrrÅܼƬO ¤Gºû°}¦C,¥HA~CÄæÀx¦s®æ¸ê®Æ±a¤J°}¦C¸Ì
ReDim Crr(1 To UBound(Brr), 1 To 3)
'¡ô«Å§iCrr¬O¤GºûªÅ°}¦C,Áa¦V½d³ò¦PBrr°}¦C,¾î¦V±q1~3
For i = 1 To UBound(Brr)
'¡ô³]¶¶°j°é
   If i = 1 Then N = 1: For j = 1 To 3: Crr(N, j) = Brr(i, j): Next
   '¡ô³B²z¼ÐÃD¦C
   If Brr(i, 1) = "¤@¯Å¤å­û" And InStr("/¤¤¤å½Òµ{/­^¤å½Òµ{/", "/" & Brr(i, 3) & "/") Then
   '¡ô¦pªG²Å¦X±ø¥ó
      If Y(Brr(i, 2) & "") = "" Then
      '¡ô¦pªG©m¦W¤£­«½Æ
         N = N + 1
         For j = 1 To 3: Crr(N, j) = Brr(i, j): Next
         '¡ô²Å¦X±ø¥ó¤S¤£­«½Æªº¸ê®Æ¼g¤JCrr°}¦C¸Ì
         Y(Brr(i, 2) & "") = 1
         '¡ô¥O¦¹¦r¨å¸Ì¦¹keyªºitem­È¬O 1(Åý«á°j°éÂo­«½Æ)
      End If
   End If
Next
[E12].Resize(N, 3) = Crr
'¡ô¥OCrr°}¦C­È±q[E12]¼g¤JÀx¦s®æ¸Ì
Set Y = Nothing: Erase Brr, Crr
'¡ô¥OÄÀ©ñÅܼÆ
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : ¡i¬°µ½Ävª§¡j¤H¥Í­n¬°µ½Ävª§¡A¤À¬í¥²ª§¡C
ªð¦^¦Cªí ¤W¤@¥DÃD