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

[µo°Ý] Ãö©ó·s¼W¸ê®Æªº¤ñ¹ï

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-5-25 16:32 ½s¿è

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

List¸ê®Æ®w:
20230525_1.jpg
2023-5-25 16:15


¸ê®Æªí(·s¤ñ¹ï¸ê®Æ):
20230525_2.jpg
2023-5-25 16:17


µ²ªGªí°õ¦æ«e:
20230525_3.jpg
2023-5-25 16:17


°õ¦æµ²ªG:
20230525_4.jpg
2023-5-25 16:18



Option Explicit
Sub TEST()
Dim Brr, Y, R&, i&, j&, T$
'¡ô«Å§iÅܼÆ
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OYÅܼƬO¦r¨å
Brr = Range([List!C1], [List!A65536].End(xlUp))
'¡ô¥OBrrÅܼƬO ¤Gºû°}¦C,¥HListªíA~CÄæÀx¦s®æ­È±a¤J°}¦C¸Ì
For i = 2 To UBound(Brr)
'¡ô³]¶¶°j°é
   T = Brr(i, 1) & Brr(i, 2) & Brr(i, 3): Y(T) = i
   '¡ô¥O¥H¨C­Ó°j°é3Äæ­È²Õ¦¨ªº·s¦r¦ê·íkey,item¬O¦C¸¹,¯Ç¤JY¦r¨å
Next
Brr = Range([¸ê®Æ!C1], [¸ê®Æ!A65536].End(xlUp))
'¡ô¥OBr°}¦C,´«¸Ë¸ê®ÆªíA~CÄæÀx¦s®æ­È
For i = 2 To UBound(Brr)
'¡ô³]¶¶°j°é
   T = Brr(i, 1) & Brr(i, 2) & Brr(i, 3)
   If Y(T) <> "" Then GoTo i01
   '¡ô¦pªG¥H°j°é3Äæ­È²Õ¦¨ªº·s¦r¦ê¬dY¦r¨å±oitem­È¤£¬OªÅªº,
   '´N¸õ¨ì¼Ð¥Üi01¦ì¸mÄ~Äò°õ¦æ

   R = R + 1
   '¡ô¥ORÅܼƲ֥[1
   For j = 1 To 3: Brr(R, j) = Brr(i, j): Next
   '¡ô³]¶¶°j°é!±NBrr°}¦C­È©¹¤WÁÃ,±N­ì°}¦C­ÈÂл\
i01: Next
If R = 0 Then MsgBox "µL·s¼W": GoTo i02
'¡ô¦pªGRÅܼƬOªì©l­È0,´N¸õ¨ì¼Ð¥Üi02¦ì¸mÄ~Äò°õ¦æ
With Sheets("¦¹¦¸·s¼W")
   .UsedRange.Offset(1, 0).Clear
   '¡ô±Nµ²ªGªí¦³¨Ï¥ÎÀx¦s®æ©¹¤U°¾²¾1¦Cªº½d³ò²M°£
   .[A2].Resize(R, 3) = Brr
   '¡ô¥OBrr°}¦C­È¼g¤Jµ²ªGªí¤¤,¶W¥X½d³òªº°}¦C­È©¿²¤
End With
i02: Set Y = Nothing: Erase Brr
'¡ô¥OÄÀ©ñÅܼÆ
End Sub

=============================================
¸É¥R: ¥H¤U¬O±Nµ²ªG¸ê®ÆÁäJ¥t¤@°}¦Cªº¤èªk

Option Explicit
Sub TEST_1()
Dim Brr, Crr, Y, R&, i&, j&, T$
'¡ô«Å§iÅܼÆ
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OYÅܼƬO¦r¨å
Brr = Range([List!C1], [List!A65536].End(xlUp))
'¡ô¥OBrrÅܼƬO ¤Gºû°}¦C,¥HListªíA~CÄæÀx¦s®æ­È±a¤J°}¦C¸Ì
For i = 2 To UBound(Brr)
'¡ô³]¶¶°j°é
   T = Brr(i, 1) & Brr(i, 2) & Brr(i, 3): Y(T) = i
   '¡ô¥O¥H¨C­Ó°j°é3Äæ­È²Õ¦¨ªº·s¦r¦ê·íkey,item¬O¦C¸¹,¯Ç¤JY¦r¨å
Next
Brr = Range([¸ê®Æ!C1], [¸ê®Æ!A65536].End(xlUp))
'¡ô¥OBr°}¦C,´«¸Ë¸ê®ÆªíA~CÄæÀx¦s®æ­È
ReDim Crr(1 To UBound(Brr), 1 To 3)
'¡ô«Å§iCrrÅܼƬO ¤GºûªÅ°}¦C,Áa¦V½d³ò¦PBrr,¾î¦V1~3
For i = 2 To UBound(Brr)
'¡ô³]¶¶°j°é
   T = Brr(i, 1) & Brr(i, 2) & Brr(i, 3)
   If Y(T) <> "" Then GoTo i01
   '¡ô¦pªG¥H°j°é3Äæ­È²Õ¦¨ªº·s¦r¦ê¬dY¦r¨å±oitem­È¤£¬OªÅªº,
   '´N¸õ¨ì¼Ð¥Üi01¦ì¸mÄ~Äò°õ¦æ

   R = R + 1
   '¡ô¥ORÅܼƲ֥[1
   For j = 1 To 3: Crr(R, j) = Brr(i, j): Next
   '¡ô³]¶¶°j°é!±NBrr°}¦C­È¼g¤JCrr°}¦C¤¤
i01: Next
If R = 0 Then MsgBox "µL·s¼W": GoTo i02
'¡ô¦pªGRÅܼƬOªì©l­È0,´N¸õ¨ì¼Ð¥Üi02¦ì¸mÄ~Äò°õ¦æ
With Sheets("¦¹¦¸·s¼W")
   .UsedRange.Offset(1, 0).Clear
   '¡ô±Nµ²ªGªí¦³¨Ï¥ÎÀx¦s®æ©¹¤U°¾²¾1¦Cªº½d³ò²M°£
   .[A2].Resize(R, 3) = Crr
   '¡ô¥OCrr°}¦C­È¼g¤Jµ²ªGªí¤¤,¶W¥X½d³òªº°}¦C­È©¿²¤
End With
i02: Set Y = Nothing: Erase Brr, Crr
'¡ô¥OÄÀ©ñÅܼÆ
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : §ïÅܦۤv¬O¦Û±Ï¡A¼vÅT§O¤H¬O±Ï¤H¡C
ªð¦^¦Cªí ¤W¤@¥DÃD