- ©«¤l
- 1446
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1470
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-10-21
|
¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-3-15 20:20 ½s¿è
¦^´_ 11# hugh0620
¦^´_ 16# Hsieh
ÁÂÁ½׾Â,ÁÂÁ«e½ú
«á¾ÇÂǦ¹©«¾Ç²ß¨ì«Ü¦hª¾ÃÑ,¥H¤U¤ß±oµù¸Ñ,½Ð«e½ú¦A«ü¾É
Option Explicit
Sub TEST()
Dim Ay(), d, d1, ar, i, a, s, mystr1
'¡ô«Å§iÅܼÆ:Ay¬O°}¦C,¨ä¾l¬°³q¥Î«¬ÅܼÆ
Set d = CreateObject("Scripting.Dictionary")
'¡ô¥Od¬O ¦r¨å
Set d1 = CreateObject("Scripting.Dictionary")
'¡ô¥Od1¤]¬O ¦r¨å
With Sheet2
'¡ô¥H¤U¬OÃö©óSheet2¤u§@ªíªºµ{§Ç (Dataªí)
.Unprotect "1234"
'¡ô¥O¥H"1234"±K½X¨ú®ø«OÅ@¤u§@ªí
ar = .Range(.[B5], .[B65536].End(xlUp).Offset(, 2))
'¡ô¥OarÅܼƬO¤Gºû°}¦C,¥H[B5]¨ì(BÄæ³Ì«á¤@Ó¦³¤º®eÀx¦s®æ,
'¦A¦V¥k°¾²¾2Ä檺Àx¦s®æ),¦¹½d³òÀx¦s®æȱa¤Jar°}¦C¤¤
For i = 1 To UBound(ar, 1)
'¡ô³]¶¶°j°é!i±q1¨ì arÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
mystr1 = Join(Array(ar(i, 1), ar(i, 2), ar(i, 3)))
'¡ô¥Omystr1ÅܼƬO¥H ªÅ¥Õ¦r¤¸³sµ²°}¦C¤lȪº·s¦r¦ê
'°}¦C¤lÈ:i°j°é¼Æªº(1,2,3)Äæar°}¦CÈ
d(mystr1) = d.Count
'¡ô¥O¥Hmystr1ÅܼƷíkey,item¬O d¦r¨åkey¼Æ¶q(PS:°_©lȬO0),¯Ç¤Jd¦r¨å
Next
With Sheet1
'¡ô¥H¤U¬OÃö©óSheet1¤u§@ªíªºµ{§Ç (¿é¤Jªí)
ar = .Range(.[B5], .[B65536].End(xlUp).Offset(, 6))
'¡ô¥OarÅܼƸ˷s¸ê®Æ:
'¥Oar¬O¤Gºû°}¦C,¥H[B5]¨ì(BÄæ³Ì«á¤@Ó¦³¤º®eÀx¦s®æ,
'¦A¦V¥k°¾²¾6Ä檺Àx¦s®æ),¦¹½d³òÀx¦s®æȱa¤Jar°}¦C¤¤
For i = 1 To UBound(ar, 1)
'¡ô³]¶¶°j°é!i±q1¨ì arÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
mystr1 = Join(Array(ar(i, 1), ar(i, 2), ar(i, 6)))
'¡ô¥Omystr1ÅܼƬO¥H ªÅ¥Õ¦r¤¸³sµ²°}¦C¤lȪº·s¦r¦ê
'°}¦C¤lÈ:i°j°é¼Æªº(1,2,6)Äæar°}¦CÈ
If d.exists(mystr1) = False Then
'¡ô¦pªG¬dd¦r¨å¸Ì¨S¦³ mystr1ÅÜ¼Æ key
ReDim Preserve Ay(s)
'¡ô¥OAy°}¦CÂX¥R¦C¼Æ¨ì¯Á¤Þ¸¹s(PS:s°_©lȬO0)
Ay(s) = Array(ar(i, 1), ar(i, 2), ar(i, 6), ar(i, 7))
'¡ô¥OsÅܯÁ¤Þ¸¹Ay°}¦CȬO¤@ºû°}¦C,¥Hi°j°é¦Car°}¦C¤lÈ(1,2,6,7)±a¤J
s = s + 1
'¡ô¥OsÅܼƲ֥[ 1
Else
d1(mystr1) = ar(i, 7)
'¡ô§_«h¥O¥Hmystr1ÅܼƬ°key,item¬Oi°j°é¦C²Ä7Äæar°}¦CÈ,¯Ç¤Jd1¦r¨å¤¤
End If
Next
End With
For Each a In .Range(.[B5], .[B65536].End(xlUp))
'¡ô³]³v¶µ°j°é!¥Oa¬O (Dataªí[B5]¨ì BÄæ³Ì«á¤@Ó¦³¤º®eÀx¦s®æ)³o½d³òÀx¦s®æ¤§¤@
mystr1 = Join(Array(a, a.Offset(, 1), a.Offset(, 2)))
'¡ô¥Omystr1ÅܼƬO¥H ªÅ¥Õ¦r¤¸³sµ²°}¦C¤lȪº·s¦r¦ê
'°}¦C¤lÈ:aÅܼÆÈ,aÅܼƩ¹¥k°¾²¾1®æªºÀx¦s®æÈ,aÅܼƩ¹¥k°¾²¾2®æªºÀx¦s®æÈ
a.Offset(, 3) = d1(mystr1)
'¡ô¥OaÅܼƩ¹¥k°¾²¾3®æªºÀx¦s®æȬO ¥Hmystr1ÅܼƬdd1¦r¨åªºitemÈ
Next
If s > 0 Then
'¡ô¦pªGsÅܼƤj©ó 0?
.[B65536].End(xlUp).Offset(1, 0).Resize(s, 4) = _
Application.Transpose(Application.Transpose(Ay))
'¡ô¥ODataªíBÄæ²Ä1ªÅ¥Õ®æÂX®i¦V¤Us1ÅܼƦC,¦V¥kÂX®i4Äæ,
'³oÂX®i½d³òÀx¦s®æÈ¥HAy°}¦CÂà¸m¨â¦¸ªºÈ±a¤J
End If
.Protect "1234"
'¡ô¥O¥H"1234"±K½X«OÅ@Dataªí
End With
End Sub |
|