- ©«¤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
|
¦^´_ 2# Hsieh
ÁÂÁ«e½ú
¤Ó¼F®`¤F!«á¾Çı±o«ÜÃø!
«á¾Ç¦b¦¹©«¾Ç¨ì«Ü¦hª¾ÃÑ!
±N¤ß±o¦b¦¹µù¸Ñ¤@¤U
¦p¦³«_¥Ç½Ð¨£½Ì!¤]Àµ½Ð«e½ú«ü¥¿¨Ã«ü¾É!
Sub Ex_Hsieh()
Dim Sh As Worksheet, Ar(), A As Range, B As Range, C As Range, s&, i%
'¡ô«Å§iÅܼÆ
Set d = CreateObject("Scripting.Dictionary")
'¡ô¥Od ¬O¦r¨å
Set d1 = CreateObject("Scripting.Dictionary")
'¡ô¥Od1 ¬O¦r¨å
For Each Sh In Sheets(Array("Sheet1", "Sheet2", "Sheet3", "Sheet4"))
'¡ô³]¥~°j°é,¥O Sh ¬O4Ó¤u§@ªí¤§¤@,¶¶µÛ¶]
With Sh
'¡ô¥H¤UÃö©óSh ¤u§@ªíªºµ{§Ç
Set C = IIf(i = 0 Or i = 2, .[A1], .[C1])
'¡ô¥OCÀx¦s®æª«¥óÅܼÆ:¦pªGi³oÅܼƬO0©Î2, CÀx¦s®æ=Shªº[A1]Àx¦s®æ
',¦pªGi³oÅܼƤ£¬O0©Î2, CÀx¦s®æ=Shªº[C1]Àx¦s®æ
For Each A In .Range(C, .[IV1].End(xlToLeft))
'¡ô³]¤¤°j°é,¥OA Àx¦s®æª«¥óÅܼƬO??
'·íi=0(ªì©lÈ):C¬O[A1]Àx¦s®æ,.[IV1].End(xlToLeft)¬O²Ä¤@¦C³Ì¥ªÃ䪺Àx¦s®æ
'©Ò¥HA ¬O Sheet1 ªº[A1:H1]ªºÀx¦s®æ¤§¤@
ReDim Preserve Ar(s)
'¡ô½Õ¾ãAr°}¦C¤j¤p¡A«O¯d°}¦C¤º³¡¸ê®Æ
'¤@¶}©lAr ¬O¤@ºû°}¦C,sªì©lȬO0,Ar(0) ¬O¨S¦³¸ê®Æ
Ar(s) = A.Value
'¡ô¥OAr¬O¼ÐÃD¦CªºÈ
s = s + 1
'¡ô¥O²Ö¥[1,ÅýAr°}¦C©¹¥k ±Æ¤J¼ÐÃD¦CªºÈ
DDD = .Range(A.Offset(1, 0), .Cells(65536, A.Column).End(xlUp)).Address
For Each B In .Range(A.Offset(1, 0), .Cells(65536, A.Column).End(xlUp))
'¡ô³]¤º°j°é,¥O BÀx¦s®æª«¥óÅܼÆ:A¼ÐÃD¦C®æ°¾¤U1®æ¨ì ·íÄ檺³Ì«á¤@®æ
'·íi=0(ªì©lÈ);Sh=Sheet1;A=[A1];B=[A2:A105]
'©Ò¥H B Sheet1 ªº[A2:A105]ªºÀx¦s®æ¤§¤@
If i = 0 Then
'¡ô¦pªGi¬Oªì©lÈ0,¤]´N¬O¤u§@ªí¬O Sheet1 ®É
'¥Øªº¬On¦¬¶°¼ÐÃDÄæ¨âÄ檺ȻP ¤é´Á&ªÑ¥N¸¹&¼ÐÃD¦C®æ ©é¦r¦êªºkey,Item¬O CreditMoneyÄæÈ
d1(.Cells(B.Row, 1) & .Cells(B.Row, 2)) = Array(.Cells(B.Row, 1), .Cells(B.Row, 2))
'¡ô±ø¥ó¦¨¥ß®É d1¦r¨å¸Ë¤J ¤é´Á&ªÑ¥N¸¹ ©é¦r¦êªº key ,Item¬O®Ô¤¸¯Àªº¤@ºû°}¦C ¤é´Á;ªÑ¥N¸¹
d(.Cells(B.Row, 1) & .Cells(B.Row, 2) & A) = B.Value
'¡ô±ø¥ó¦¨¥ß®É d¦r¨å¸Ë¤J ¤é´Á&ªÑ¥N¸¹&¼ÐÃD¦C®æ ©é¦r¦êªºkey,Item¬O CreditMoneyÄæÈ
ElseIf d1.exists(.Cells(B.Row, 1) & .Cells(B.Row, 2)) = True Then
'¡ô¦pªGi¤£¬O¬Oªì©lÈ0:¤u§@ªí¤£¬O Sheet1 ®É
',¦Ó¥B d1¦r¨å¸Ì¦³ ¤é´Á&ªÑ¥N¸¹ ©é¦r¦êªº key®É
d(.Cells(B.Row, 1) & .Cells(B.Row, 2) & A) = B.Value
'¡ô±ø¥ó¦¨¥ß®É d¦r¨å¸Ë¤J ¤é´Á&ªÑ¥N¸¹&¼ÐÃD¦C®æ ©é¦r¦êªºkey,Item¬O CreditMoneyÄæÈ
End If
Next
Next
i = i + 1
End With
Next
With Sheet5
'¡ô¥H¤UÃö©ó ²Ä5Ó¤u§@ªíªºµ{§Ç
.Cells = ""
'¡ô¥O©Ò¦³Àx¦sÓ³£¬OªÅ¦r¤¸
.[A1].Resize(, s) = Ar
'¡ô§â¦¬¶°¨ìªºAr¼ÐÃD¤@ºû°}¦C±q[A1]¶}©lªºÀx¦s®æ©ñ¶iÈ
r = d1.Count
'¡ô¥Or ¬Od1¦r¨å¸Ì¤¸¯À¼Æ¶q104
.[A2].Resize(d1.Count, 2) = Application.Transpose(Application.Transpose(d1.items))
'¡ô§â¦¬¶°¨ìd1¦r¨åªºitem(¨âÄæ¼ÐÃD) ±q[A2]¶}©lªºÀx¦s®æ©ñ¶iÈ
For Each C In .Range(.[C1], .[IV1].End(xlToLeft))
'¡ô³]¥~°j°é¥O CÀx¦s®æª«¥óÅܼƬO Sheet5 ªº[C1:AK1]ªºÀx¦s®æ¤§¤@
'¤]´N¬Oµ²ªGªíªº¼Ð´£¦CÀx¦s®æ
For Each A In C.Offset(1, 0).Resize(d1.Count, 1)
'¡ô³]¤º°j°é¥O AÀx¦s®æª«¥óÅܼƬO C¼ÐÃD¦CÀx¦s®æ°¾¤U¤@®æ¶}©l,
'©¹¤U¦J¦C (d1¦r¨å¸Ì¤¸¯À¼Æ¶q) ªºÀx¦s®æ 104®æ ªºÀx¦s®æ¤§¤@
A = d(.Cells(A.Row, 1) & .Cells(A.Row, 2) & C)
'¡ô¥Î¨â¼ÐÃDÄæ¨â®æÈ»P¼ÐÃD¦C®æ©éªº¦r¦ê·íkey,
'½Õ¥Xd¦r¨å¸ÌªºItem È©ñ¨ìÀx¦s®æ²z
Next
Next
End With
End Sub |
|