- ©«¤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-12-5
|
ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
¬Q¤Ñ³o©«·Q¤£¨ì¤èªk,¼È®ÉÀÁ¤U,¬Q±ß¹B°Ê§¹¬ðµM·Q¨ì¥Î°Ñ·Óªí»P¸ê®Æªí¥H»²§UÄæ²V©M±Æ§Ç,´N¥i¥H©ú½Tª¾¹D¾¯Å,±N¥L¯Ç¤J¦r¨å,¦A¦R¥X¨Ó
¤µ¤Ñ¦¤W±N¬Q±ß·Q¨ìªº¤èªk¹ê²{,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü¾É§ó¦nªº¿ìªk
°õ¦æ«e:
»²§UÄæ±Æ§Ç«á:
°õ¦æµ²ªG:
Option Explicit
Sub TEST()
Dim Brr(1 To 1000, 1 To 4), Crr, A(3), Y, X&, R&, i&, C%, j%, K%, P$, Q$
'¡ô«Å§iÅܼÆ
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OYÅܼƬO ¦r¨å
Range([D2], [D65536].End(3)(2)).ClearContents
'¡ô¥Oµ²ªGÄæÀx¦s®æ²M°£¤º®e
A(1) = Range([D2], [A65536].End(3))
A(2) = Range([I2], [F65536].End(3))
A(3) = Range([M2], [J65536].End(3))
'¡ô¥OAÅܼƳo ¤@ºû°}¦Cªº1~3°}¦CȦU¬°¤Gºû°}¦C,¦U¥HÀx¦s®æȱa¤J
For i = 1 To 3
For R = 1 To UBound(A(i))
X = X + 1
For C = 1 To 4: Brr(X, C) = A(i)(R, C): Next
Next
Next
'¡ô³]°j°é±N3Ó¤Gºû°}¦C¼g¤JBrr°}¦C¸Ì
C = Range([A1], ActiveSheet.UsedRange).Columns.Count
'¡ô¥OCÅܼƬO°»´ú¨Ï¥ÎÀx¦s®æ³Ì¥kÃäÄæ¼Æ
With Cells(1, C + 1).Resize(X, 4)
'¡ô¦b¨Ï¥ÎÀx¦s®æ¥k°¼¼W³]»²§UÀx¦s®æ(¤£¼vÅTì©l¸ê®Æ¬°ì«h)
.Value = Brr
.Sort KEY1:=.Item(1), Order1:=1, _
Key2:=.Item(2), Order2:=1, _
key3:=.Item(3), Order3:=2, _
Header:=xlNo, Orientation:=xlTopToBottom
'¡ô±N°}¦Cȼg¤J»²§UÀx¦s®æ«á,°µ3¼h±Æ§Ç
Crr = .Value
'¡ô¥OCrrÅܼƬO ¤Gºû°}¦C,¸Ë¤J»²§UÀx¦s®æ±Æ§Ç«áªºÈ
For i = 1 To UBound(Crr)
'¡ô³]¶¶°j°é!
P = Crr(i, 1) & "|" & Crr(i, 2) & "|" & Crr(i, 3)
'¡ô¥OP¬O1~3Äæi°j°é¦CCrr°}¦C,¥H"|"¶¡¹j²Õ¦¨ªº·s¦r¦ê
If InStr(P, Q) <> 1 Then K = 10
'¡ô¦]¬°¦³¨ÇÁ~¸ê¤j©ó10¯ÅÁ~¸ê,¦Ó±Æ§Ç®É¦C¦b°j°é³Ì«e±,
'©Ò¥H¥un°»´ú¨ì(©Ê½è|¾§O)¤£¦P«e¤@°j°é,´N¥ý¥OK=10
If Crr(i, 4) <> "" Then
Q = Crr(i, 1) & "|" & Crr(i, 2): K = Crr(i, 4)
End If
Y(P) = K
'¡ô¥OP³o²Õ¦X¦r¦ê·íkey,item¬OKÅܼÆ,¯Ç¤JY¦r¨å¸Ì
Next
.EntireColumn.Delete
'¡ô¥O»²§UÀx¦s®æÄæ¦ì§R°£
End With
Crr = A(1)
'¡ô¥OCrr´«¸Ë A(1)³o¤Gºû°}¦C
For i = 1 To UBound(Crr)
'¡ô³]¶¶°j°é
P = Crr(i, 1) & "|" & Crr(i, 2) & "|" & Crr(i, 3)
Crr(i, 1) = Y(P)
'¡ô¥O¥HP³o²Õ¦X¦r¦ê¬dY¦r¨å±o¨ìªºitemȼg¤JCrr°}¦C²Ä1Äæ¸Ì,
'¼g¦bCrr°}¦C²Ä1Ä檺ì¦]¬O¤è«K±N°}¦Cȼg¤JÀx¦s®æ¸Ì,
'²¦³º²Ä1Ä檺°}¦CÈ°£¤F³Q¥Î¨Ó²Õ¦X¦¨PÅܼƤ]¨S¦³¥Î³~¤F
Next
[D2].Resize(UBound(Crr), 1) = Crr
'¡ô¥OCrr°}¦C²Ä1Äæȼg¤J±q[D2]¶}©lªºÀx¦s®æ¤¤
Set Y = Nothing: Erase Brr, Crr, A
'¡ô¥OÄÀ©ñÅܼÆ
End Sub |
|