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