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

¶×¥X_¦ý¤£­«ÂжץXªº¸ê®Æ

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾Ç¤µ¤ÑÂǦ¹©«½m²ß°}¦C»P¦r¨å,½Ð¦U¦ì«e½ú«ü±Ð
¶×¥X_¦ý¤£­«ÂÐ_20230316_4.zip (15.37 KB)

¸ê®Æªí:


­ìµ²ªGªí:


°õ¦æµ²ªG:


Option Explicit
Sub TEST_1()
Dim A, B, V, Y, Z, C%, R&, i&, N&, T$, xR
Set Y = CreateObject("Scripting.Dictionary")
[Data!F:F].ClearContents
Set xR = Range([Data!F5], [Data!B65536].End(3))
A = xR: B = Range([¿é¤J!H5], [¿é¤J!B65536].End(3))
ReDim V(UBound(B), 4): Z = Array(1, 2, 6, 7)
For i = 1 To UBound(A)
   T = Join(Array(A(i, 1), A(i, 2), A(i, 3)), "|")
   Y(T) = i: Y(T & "/c4") = A(i, 4)
Next
For i = 1 To UBound(B)
   T = Join(Array(B(i, 1), B(i, 2), B(i, 6)), "|")
   If Y.Exists(T) Then
      N = Y(T)
      If B(i, 7) <> Y(T & "/c4") And N <= UBound(A) Then
         A(N, 5) = Date & "_" & A(N, 4) & "_­×§ï¬°_" & B(i, 7)
         A(N, 4) = B(i, 7)
      End If
      Else
         For C = 0 To 3: V(R, C) = B(i, Z(C)): Next
         V(R, 4) = "·s¼W"
         R = R + 1: Y(T) = i: Y(T & "/c4") = B(i, 7)
   End If
Next
xR.Value = A
If R > 0 Then xR.Item(xR.Count + 1).Resize(R, 5) = V
Application.Goto [Data!A1]
Set Y = Nothing: Erase A, B, V
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¥»©«³Ì«á¥Ñ 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
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : ­n¤ñ½Ö§ó¨ü½Ö¡D¤£­n¤ñ½Ö§ó©È½Ö¡C
ªð¦^¦Cªí ¤W¤@¥DÃD