- ©«¤l
 - 1527 
 - ¥DÃD
 - 40 
 - ºëµØ
 - 0 
 - ¿n¤À
 - 1551 
 - ÂI¦W
 - 0  
 - §@·~¨t²Î
 - Windows  7 
 - ³nÅ骩¥»
 - Excel 2010 & 2016 
 - ¾\ŪÅv
 - 100 
 - ©Ê§O
 - ¨k 
 - ¨Ó¦Û
 - ¥xÆW 
 - µù¥U®É¶¡
 - 2020-7-15 
 - ³Ì«áµn¿ý
 - 2025-11-4 
 
  | 
                
 ¥»©«³Ì«á¥Ñ 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 |   
 
 
 
 |