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

[µo°Ý] ¸Uµ§¸ê®Æ§Ö³t¤ñ¹ï³B²z

¦^´_ 10# mhl9mhl9


TO
mhl9mhl9

ÁÂÁ¤j¤j¸Ñ»¡µ{¦¡½XªºÅ޿趶§Ç
§Ú¦A¦n¦n¬ã¨s¬Ý¬Ý!
ÁÂÁÂ!!¥H«á½Ð¦h¦h«ü±Ð!!
VBA ±q0¶}©l
¥ý±q¾Ç·|¬ÝªºÀ´¶}©l
¥ý±q·|¦³°ò¥»­×§ï¯à¤O¶}©l
¤@¨B¤@¨B¾Ç²ß¤¤

TOP

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

°õ¦æ«e:
20230524_1.jpg
2023-5-24 16:31


°õ¦æµ²ªG:
20230524_2.jpg
2023-5-24 16:31



Option Explicit
Sub TEST() '¡ô
Application.ScreenUpdating = False
Dim Brr, Y, R&, i&, T$, ST
ST = Timer
Set Y = CreateObject("Scripting.Dictionary")
Brr = Range([¤u§@ªí2!B1], [¤u§@ªí2!A65536].End(3))
For i = 1 To UBound(Brr): T = Brr(i, 1): Y(T) = 1: Next
Brr = Range([¤u§@ªí1!B1], [¤u§@ªí1!B65536].End(3))
For i = 1 To UBound(Brr): T = Brr(i, 1): Brr(i, 1) = Y(T): Y(T) = "": Next
[¤u§@ªí1!I1].Resize(UBound(Brr), 1) = Brr
With Range([¤u§@ªí1!I1], [¤u§@ªí1!A65536].End(3))
   .Sort KEY1:=.Item(9), Order1:=1, Header:=1, Orientation:=1
End With
R = [I1].End(xlDown).Row
Rows(R + 1 & ":65536").Clear
[I:I].Clear
Set Y = Nothing: Erase Brr
MsgBox Format(Timer - ST, "0.0’")
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½Æ²ß¤è®×,¤è®×½Æ²ß¤ß±oµù¸Ñ¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð

Option Explicit
Sub TEST()
Application.ScreenUpdating = False
'¡ô¥O¿Ã¹õµe­±¤£ÀHµ{§ÇÅܤƵ²ªG
Dim Brr, Y, R&, i&, T$, ST, S
'¡ô«Å§iÅܼÆ
ST = Timer
'¡ô¥OSTÅܼƬO ·í¤U®É¶¡
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OYÅܼƬO ¦r¨å
Brr = Range([¤u§@ªí2!B1], [¤u§@ªí2!A65536].End(3))
'¡ô¥OBrrÅܼƬO ¤Gºû°}¦C,¥Hªí2ªºA~BÄæÀx¦s®æ­È±a¤J°}¦C¤¤
For i = 1 To UBound(Brr): T = Brr(i, 1): Y(T) = 1: Next
'¡ô³]¶¶°j°é!¥O¥HªÑ²¼¥N¸¹·íkey,item¬O1,¯Ç¤JY¦r¨å¤¤
Brr = Range([¤u§@ªí1!B1], [¤u§@ªí1!B65536].End(3))
'¡ô¥OBrr°}¦C´«¸Ëªí1ªºBÄæÀx¦s®æ­È
For i = 1 To UBound(Brr): T = Brr(i, 1): Brr(i, 1) = Y(T): Y(T) = "": Next
'¡ô³]¶¶°j°é!±NBrr¦^°j°é°}¦C­È´«¦¨¬dY¦r¨å±o¨ìªºitem­È,
'¨ÃÅý­«½Ækey¬dY¦r¨åªºitem­ÈÅܦ¨ ªÅ¦r¤¸,¥u¯d¤@µ§­È¬O1

[¤u§@ªí1!I1].Resize(UBound(Brr), 1) = Brr
'¡ô¥Oªí1ªºIÄæ·í»²§UÄæ,¥OBrr°}¦C­È¼g¤JIÄ椤
With Range([¤u§@ªí1!I1], [¤u§@ªí1!A65536].End(3))
   .Sort KEY1:=.Item(9), Order1:=1, Header:=1, Orientation:=1
End With
'¡ô¥O¥HIÄ欰±Æ§Ç°ò·Ç,°µ¦³¼ÐÃD¦CªºÁa¦V¶¶±Æ§Ç
R = [I1].End(xlDown).Row
'¡ô¥ORÅܼƬO±Æ§Ç«á IÄæ³Ì«á¤@­Ó¦³¤º®eªºÀx¦s®æ¦C¸¹
Rows(R + 1 & ":65536").Clear
'¡ô¥OIÄæ¬OªÅ®æªº¦C³q³q²M°£
'¦]¬°¦³±Æ§ÇªºÃö«Y,IÄæ¬OªÅ®æªº¦C³QÀ½¨ì«á¤è¤F
[I:I].Clear
'¡ô¥O³oIÄæ(»²§UÄæ)¥\¦¨¨­°h!°µ²M°£
Set Y = Nothing: Erase Brr
'¡ô¥OÄÀ©ñÅܼÆ
S = Format(Timer - ST, "0.0’")
MsgBox Format(Timer - ST, "0.0’")
'¡ô¥O¸õ¥X´£¥Üµ¡,Åã¥Ü¦¹·í¤U®É¶¡-STÅܼƫáÂà¤Æ¬°¦³1¦ì¤p¼Æªº"?.?¬í"¦r¦ê
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

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

Option Explicit
Sub TEST_2()
Dim Arr, Brr, Crr, Y, R&, i&, j&, ST
'¡ô«Å§iÅܼÆ
ST = Timer
'¡ô¥OSTÅܼƬO ·í¤U®É¶¡
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OYÅܼƬO ¦r¨å
Brr = Range([¤u§@ªí2!A1], [¤u§@ªí2!A65536].End(3))
'¡ô¥OBrrÅܼƬO ¤Gºû°}¦C,¥Hªí2ªºAÄæÀx¦s®æ­È±a¤J°}¦C¤¤
For i = 1 To UBound(Brr): Y(Brr(i, 1) & "") = i: Next
'¡ô³]¶¶°j°é!¥O¥HªÑ²¼¥N¸¹·íkey,item¬Oi°j°é¼Æ(¦C¸¹),¯Ç¤JY¦r¨å¤¤
Arr = Range([¤u§@ªí1!H1], [¤u§@ªí1!A65536].End(3))
'¡ô¥OArrÅܼƬO ¤Gºû°}¦C,¥Hªí1ªºA~HÄæÀx¦s®æ­È±a¤J°}¦C¤¤
ReDim Crr(1 To UBound(Arr), 1 To 8)
'¡ô«Å§iCrrÅܼƬO ¤GºûªÅ°}¦C,Áa¦V½d³ò¦PArr°}¦C,¾î¦V1~8
For i = 1 To UBound(Arr)
'¡ô³]¶¶°j°é!
   If Y(Arr(i, 2) & "") = "" Then GoTo i01
   '¡ô¦pªG¥HªÑ²¼¥N¸¹¬dY¦r¨å±oitem­È¬OªÅªº!´N¸õ¨ìi01¼Ð¥Ü¦ì¸mÄ~Äò°õ¦æ
   R = R + 1
   '¡ô¥ORÅܼƲ֥[1 (µ²ªG­È©ñ¸mªº¦C¸¹)
   For j = 1 To 8: Crr(R, j) = Arr(i, j): Next
   '¡ô³]¶¶°j°é!±NArr°}¦C­ÈÁèìCrr°}¦C¸Ì
   Y(Arr(i, 2) & "") = ""
   '¡ô¥O¥HªÑ²¼¥N¸¹ªºkey¹ïÀ³ªºitem§ï¬°ªÅªº
i01: Next
With Sheets("¤u§@ªí1")
   .UsedRange.Clear
   '¡ô¥O²M°£Â¸ê®Æ
   .[A1].Resize(R, 8) = Crr
   '¡ô¥OCrr°}¦C­È¼g¤JÀx¦s®æ¸Ì
End With
Set Y = Nothing: Erase Arr, Brr, Crr
'¡ô¥OÄÀ©ñÅܼÆ
MsgBox Format(Timer - ST, "0.0’")
'¡ô¥O¸õ¥X´£¥Üµ¡,Åã¥Ü¦¹·í¤U®É¶¡-STÅܼƫáÂà¤Æ¬°¦³1¦ì¤p¼Æªº"?.?¬í"¦r¦ê
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

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

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß±N¤W¤@©«3­Ó°}¦C´î¬°2­Ó°}¦C,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð

Option Explicit
Sub TEST_3()
Dim Arr, Brr, Y, R&, i&, j&, ST
'¡ô«Å§iÅܼÆ
ST = Timer
'¡ô¥OSTÅܼƬO ·í¤U®É¶¡
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OYÅܼƬO ¦r¨å
Brr = Range([¤u§@ªí2!A1], [¤u§@ªí2!A65536].End(3))
'¡ô¥OBrrÅܼƬO ¤Gºû°}¦C,¥Hªí2ªºAÄæÀx¦s®æ­È±a¤J°}¦C¤¤
For i = 1 To UBound(Brr): Y(Brr(i, 1) & "") = i: Next
'¡ô³]¶¶°j°é!¥O¥HªÑ²¼¥N¸¹·íkey,item¬Oi°j°é¼Æ(¦C¸¹),¯Ç¤JY¦r¨å¤¤
Arr = Range([¤u§@ªí1!H1], [¤u§@ªí1!A65536].End(3))
'¡ô¥OArrÅܼƬO ¤Gºû°}¦C,¥Hªí1ªºA~HÄæÀx¦s®æ­È±a¤J°}¦C¤¤
For i = 1 To UBound(Arr)
'¡ô³]¶¶°j°é!
   If Y(Arr(i, 2) & "") = "" Then GoTo i01
   '¡ô¦pªG¥HªÑ²¼¥N¸¹¬dY¦r¨å±oitem­È¬OªÅªº!´N¸õ¨ìi01¼Ð¥Ü¦ì¸mÄ~Äò°õ¦æ
   R = R + 1
   '¡ô¥ORÅܼƲ֥[1 (µ²ªG­È©ñ¸mªº¦C¸¹)
   For j = 1 To 8: Arr(R, j) = Arr(i, j): Next
   '¡ô³]¶¶°j°é!±NArr°}¦C­È©¹¤WÁÃ,Âл\±¼­ì°}¦C­È
   Y(Arr(i, 2) & "") = ""
   '¡ô¥O¥HªÑ²¼¥N¸¹ªºkey¹ïÀ³ªºitem§ï¬°ªÅªº
i01: Next
With Sheets("¤u§@ªí1")
   .UsedRange.Clear
   '¡ô¥O²M°£Â¸ê®Æ
   .[A1].Resize(R, 8) = Arr
   '¡ô¥OArr°}¦C­È¼g¤JÀx¦s®æ¸Ì,¶W¹L³oÀx¦s®æ½d³òªº°}¦C­È©¿²¤
End With
Set Y = Nothing: Erase Arr, Brr
'¡ô¥OÄÀ©ñÅܼÆ
MsgBox Format(Timer - ST, "0.0’")
'¡ô¥O¸õ¥X´£¥Üµ¡,Åã¥Ü¦¹·í¤U®É¶¡-STÅܼƫáÂà¤Æ¬°¦³1¦ì¤p¼Æªº"?.?¬í"¦r¦ê
End Sub

==============================================================
¥H¤U¬O¾Ç²ß±N¤W¤@Code ±N2­Ó°}¦C´î¬°1­Ó°}¦C,¾Ç²ß¤è®×¦p¤U


Option Explicit
Sub TEST_4()
Dim Brr, Y, R&, i&, j&, ST
'¡ô«Å§iÅܼÆ
ST = Timer
'¡ô¥OSTÅܼƬO ·í¤U®É¶¡
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OYÅܼƬO ¦r¨å
Brr = Range([¤u§@ªí2!A1], [¤u§@ªí2!A65536].End(3))
'¡ô¥OBrrÅܼƬO ¤Gºû°}¦C,¥Hªí2ªºAÄæÀx¦s®æ­È±a¤J°}¦C¤¤
For i = 1 To UBound(Brr): Y(Brr(i, 1) & "") = i: Next
'¡ô³]¶¶°j°é!¥O¥HªÑ²¼¥N¸¹·íkey,item¬Oi°j°é¼Æ(¦C¸¹),¯Ç¤JY¦r¨å¤¤
Brr = Range([¤u§@ªí1!H1], [¤u§@ªí1!A65536].End(3))
'¡ô¥OBrr°}¦C´«¸Ëªí1ªºA~HÄæÀx¦s®æ­È
For i = 1 To UBound(Brr)
'¡ô³]¶¶°j°é!
   If Y(Brr(i, 2) & "") = "" Then GoTo i01
   '¡ô¦pªG¥HªÑ²¼¥N¸¹¬dY¦r¨å±oitem­È¬OªÅªº!´N¸õ¨ìi01¼Ð¥Ü¦ì¸mÄ~Äò°õ¦æ
   R = R + 1
   '¡ô¥ORÅܼƲ֥[1 (µ²ªG­È©ñ¸mªº¦C¸¹)
   For j = 1 To 8: Brr(R, j) = Brr(i, j): Next
   '¡ô³]¶¶°j°é!±NBrr°}¦C­È©¹¤WÁÃ,Âл\±¼­ì°}¦C­È
   Y(Brr(i, 2) & "") = ""
   '¡ô¥O¥HªÑ²¼¥N¸¹ªºkey¹ïÀ³ªºitem§ï¬°ªÅªº
i01: Next
With Sheets("¤u§@ªí1")
   .UsedRange.Clear
   '¡ô¥O²M°£Â¸ê®Æ
   .[A1].Resize(R, 8) = Brr
   '¡ô¥OBrr°}¦C­È¼g¤JÀx¦s®æ¸Ì,¶W¹L³oÀx¦s®æ½d³òªº°}¦C­È©¿²¤
End With
Set Y = Nothing: Erase Brr
'¡ô¥OÄÀ©ñÅܼÆ
MsgBox Format(Timer - ST, "0.0’")
'¡ô¥O¸õ¥X´£¥Üµ¡,Åã¥Ü¦¹·í¤U®É¶¡-STÅܼƫáÂà¤Æ¬°¦³1¦ì¤p¼Æªº"?.?¬í"¦r¦ê
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : ¤H¥Í¤£¤@©w²y²y¬O¦n²y¡A¦ý¬O¦³¾ú½mªº±j¥´ªÌ¡AÀH®É³£¥i¥H´§´Î¡C
ªð¦^¦Cªí ¤W¤@¥DÃD