| ©«¤l1478 ¥DÃD40 ºëµØ0 ¿n¤À1502 ÂI¦W0  §@·~¨t²ÎWindows  7 ³nÅ骩¥»Excel 2010 & 2016 ¾\ŪÅv100 ©Ê§O¨k ¨Ó¦Û¥xÆW µù¥U®É¶¡2020-7-15 ³Ì«áµn¿ý2025-10-27 
 | 
                
| ¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-3-17 09:26 ½s¿è 
 ¦^´_ 21# Andy2483
 
 
 ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
 ¤µ¤Ñ½Æ²ß¦¹©«µo²{«Ü¦h¯Êº|,×¥¿«á¤ß±oµù¸Ñ¦p¤U,½Ð¦U«e½ú«ü±Ð
 
 Option Explicit
 Sub TEST_1()
 If [¿é¤J!B65536].End(3).Row <= 5 Then Exit Sub
 '¡ô¦pªG¿é¤JªíBÄæ³Ì«á¤@Ó¦³¤º®eÀx¦s®æ¦C¸¹<=5!´Nµ²§ôµ{¦¡°õ¦æ
 Dim A, B, V, Y, Z, C%, R&, i&, N&, T$, xR As Range
 '¡ô«Å§iÅܼÆ:(A,B,V,Y,Z)¬O³q¥Î«¬ÅܼÆ,C¬Oµu¾ã¼ÆÅܼÆ,
 '(R,i,N)¬Oªø¾ã¼ÆÅܼÆ,T¬O¦r¦êÅܼÆ,xR¬OÀx¦s®æÅܼÆ
 Set Y = CreateObject("Scripting.Dictionary")
 '¡ô¥OY³o³q¥Î«¬ÅܼƬO ¦r¨å
 [Data!F:F].ClearContents
 '¡ô¥ODataªíFÄæ²M°£¤º®e
 Set xR = Range([Data!F4], [Data!B65536].End(3))
 '¡ô¥OxR³oÀx¦s®æÅܼƬO Dataªí[F4]¨ìBÄæ³Ì«á¤@Ó¦³¤º®eÀx¦s®æ
 A = xR: B = Range([¿é¤J!H5], [¿é¤J!B65536].End(3))
 '¡ô¥OA³o³q¥Î«¬ÅܼƬO ¤Gºû°}¦C,¥HxRÅܼÆÈ(Àx¦s®æÈ)±a¤J,
 '¥OB³o³q¥Î«¬ÅܼƬO ¤Gºû°}¦C,¥H¿é¤Jªí[H5]¨ìBÄæ³Ì«á¦³¤º®eÀx¦s®æ,
 '³o½d³òÀx¦s®æÈ±a¤JB°}¦C¤¤
 ReDim V(UBound(B), 4): Z = Array(1, 2, 6, 7)
 '¡ô«Å§iV³o³q¥Î«¬ÅܼƬO ¤Gºû°}¦C,Áa¦V½d³ò±q0¨ì B°}¦CÁa¦V³Ì¤j¦C¸¹,
 '¾î¦V½d³ò±q0¨ì 4
 '¥OZ³o³q¥Î«¬ÅܼƬO ¤@ºû°}¦C,¥H¼Æ¦r(1,2,6,7)¬°¨ä°}¦CÈ
 For i = 2 To UBound(A)
 '¡ô³]¶¶°j°é!i±q2¨ì A°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
 T = Join(Array(A(i, 1), A(i, 2), A(i, 3)), "|")
 '¡ô¥OT³o¦r¦êÅܼƬO ¥H"|"³sµ²A°}¦CȪº·s¦r¦ê,
 'A°}¦CÈ:i°j°é¦C(1,2,3)ÄæA°}¦CÈ
 Y(T) = i: Y(T & "/c4") = A(i, 4)
 '¡ô¥O¥HTÅܼƬ°key,item¬O i°j°é¼Æ,¯Ç¤JY¦r¨å¸Ì
 '¥O¥HTÅܼƳsµ²"/c4"«áªº·s¦r¦ê¬°key,item¬O i°j°é¦C²Ä4ÄæA°}¦CÈ,
 '¯Ç¤JY¦r¨å¸Ì
 Next
 For i = 1 To UBound(B)
 '¡ô³]¶¶°j°é!i±q2¨ì B°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
 T = Join(Array(B(i, 1), B(i, 2), B(i, 6)), "|")
 '¡ô¥OT³o¦r¦êÅܼƬO ¥H"|"³sµ²B°}¦CȪº·s¦r¦ê,
 'B°}¦CÈ:i°j°é¦C(1,2,6)ÄæB°}¦CÈ
 If Y.Exists(T) Then
 '¡ô¦pªGY¦r¨å¸Ì¦³ TÅܼƳokey?
 N = Y(T)
 '¡ô¥ON³oªø¾ã¼ÆÅܼƬO ¥HTÅܼƬdY¦r¨å¦^¶ÇªºitemÈ
 If B(i, 7) <> Y(T & "/c4") And N <= UBound(A) Then
 '¡ô¦pªGi°j°é¦C²Ä7Äæ°}¦CȤ£µ¥©ó ¥HTÅܼƳsµ²"/c4"ªºY itemÈ
 '¦Ó¥BNÅܼÆ<= A°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹(¥Øªº:¹jÂ÷·s¼W)
 A(N, 5) = Date & "_" & A(N, 4) & "_קאּ_" & B(i, 7)
 '¡ô¥ONÅܼƦC²Ä5ÄæA°}¦CȬO ¤µ¤Ñ¤é´Á³s±µ"_",
 '¦A³s±µNÅܼƦC²Ä4ÄæA°}¦CÈ,Äò³s±µ"_קאּ_",
 '³Ì«á³s±µi°j°é¦C²Ä7ÄæB°}¦CÈ
 A(N, 4) = B(i, 7)
 '¡ô¥ONÅܼƦC²Ä4ÄæA°}¦CȬO i°j°é¦C²Ä7ÄæB°}¦CÈ
 End If
 Else
 For C = 0 To 3: V(R, C) = B(i, Z(C)): Next
 '¡ô³]¶¶°j°éC±q0¨ì 3
 '¥OR³oªø¾ã¼ÆÅܼƦC²ÄCÅܼÆÄæV°}¦CȬO
 'i°j°é¦C²Ä(CÅܼƯÁ¤Þ¸¹Z°}¦CÈ)ÄæªºB°}¦CÈ
 'RÅܼƪºªì©lȬO0,VÁa¦V¯Á¤Þ¸¹°_©lȤ]¬O0,n·f°t¤~¹ï±o·Ç
 V(R, 4) = "·s¼W"
 '¡ô¥ORÅܼƦC²Ä4ÄæV°}¦CȬO "·s¼W"¦r¦ê
 R = R + 1: Y(T) = i: Y(T & "/c4") = B(i, 7)
 '¡ô¥ORÅܼƲ֥[1:¥O¥HTÅܼƷíkey,item¬O i°j°é¼Æ,¯Ç¤JY¦r¨å¸Ì,
 '¥O¥HTÅܼƳsµ²"/c4"«áªº·s¦r¦ê¬°key,item¬O i°j°é¦C²Ä7ÄæB°}¦CÈ,
 '¯Ç¤JY¦r¨å¸Ì
 End If
 Next
 xR = A
 '¡ô¥OxRÅܼÆ(Àx¦s®æ)È ¥HA°}¦Cȱa¤J
 If R > 0 Then xR.Item(xR.Count + 1).Resize(R, 5) = V
 '¡ô¦pªGRÅܼÆ>0 !
 '´N¥OxRÅܼÆ(Àx¦s®æ)ªº¤U¤@ÓÀx¦s®æ ÂX®i¦V¤URÅܼƦC,¦V¥kÂX®i5Äæ,
 '³o½d³òÀx¦s®æÈ¥HV°}¦Cȱa¤J
 Application.Goto [Data!A1]
 '¡ô¥OÀx¦s®æ´å¼Ð¸õ¨ì [Data!A1]¦ì¸m
 Set Y = Nothing: Erase A, B, V, Z
 '¡ô¥OÄÀ©ñÅܼÆ
 End Sub
 | 
 |