- ©«¤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
|
¦^´_ 3# ã´£³¡ªL
ÁÂÁ½׾Â,ÁÂÁ«e½ú
«á¾ÇÂǦ¹©«¾Ç²ß«e½úVBA¤è®×,¤è®×¾Ç²ß¤ß±o¦p¤U,½Ð«e½ú¦A«ü¾É
°õ¦æ«e:
°õ¦æµ²ªG:
Sub TEST_A1()
Dim Arr, xD, T1$, T2$, i&
'¡ô«Å§iÅܼÆ:(Arr,xD)¬O³q¥Î«¬ÅܼÆ,(T1,T2)¬O¦r¦êÅܼÆ,i¬Oªø¾ã¼ÆÅܼÆ
Set xD = CreateObject("Scripting.Dictionary")
'¡ô¥OxD³o³q¥Î«¬ÅܼƬO ¦r¨å
Arr = Range(Sheet1.[c1], Sheet1.Cells(Rows.Count, 1).End(xlUp))
'¡ô¥OArr³o³q¥Î«¬ÅܼƬO ¤Gºû°}¦C,¥Hªí1ªºA~CÄæÀx¦s®æȱa¤J°}¦C¤¤
For i = 2 To UBound(Arr)
'¡ô³]¶¶°j°é
T1 = Arr(i, 1): T2 = Arr(i, 3)
'¡ô¥OT1³o¦r¦êÅܼƬO i°j°é¦C²Ä1ÄæArr°}¦CÈ
xD(T1) = xD(T1) + 1
'¡ô¥O¥HT1ÅܼƷíkey,item²Ö¥[1,¯Ç¤JxD¦r¨å¸Ì
xD(T1 & "/" & T2) = Arr(i, 2)
'¡ô¥OT1ÅܼƳs±µ"/",¦A³s±µT2ÅÜ¼Æ ©Ò²Õ¦¨ªº·s¦r¦ê·íkey,
'item¬O i°j°é¦C²Ä2ÄæArr°}¦CÈ
Next i
Arr = Range(Sheet2.[c1], Sheet2.Cells(Rows.Count, 1).End(xlUp))
'¡ô¥OArr°}¦C˱¼Â°}¦CÈ,´«¸Ëªí2ªºA~CÄæÀx¦s®æÈ
For i = 2 To UBound(Arr)
'¡ô³]¶¶°j°é
T1 = xD(Arr(i, 1) & "")
'¡ô¥OT1ÅܼƬO (¥Hi°j°é¦CArr°}¦CÈ)¬d xD¦r¨å¦^¶ÇitemÈ
'Arr(i, 1) & "":°}¦CÈ¥[ªÅ¦r¤¸,©w¸qÅý¥¦¬O¦r¦ê ¬d¦r¨å
T2 = xD(Arr(i, 1) & "/" & Arr(i, 2))
'¡ô¥OT2ÅܼƬO i°j°é¦C²Ä1ÄæArr°}¦Cȳs±µ"/",¦A³s±µi°j°é¦C²Ä2ÄæArr°}¦CÈ,
'©Ò²Õ¦¨ªº·s¦r¦ê
Arr(i - 1, 1) = T2 & IIf(T2 = "", "", "/") & T1
'¡ô¥OT2ÅܼƳs±µ"/"¦A³s±µT1ÅܼƩҲզ¨ªº·s¦r¦ê,
'¼g¨ìArr°}¦C¸Ì(Âл\±¼ì°}¦CÈ)
Next i
With Sheet2.[e2].Resize(UBound(Arr) - 1)
'¡ô¥H¤U¬OÃö©ó[E2]Àx¦s®æÂX®i¦V¤UArr°}¦C³Ì¤j¯Á¤Þ¸¹-1®æ,
'¦]¬°¦³®Äµ²ªGȬO±q1¯Á¤Þ¸¹¶}©l©ñ,©Ò¥Hn-1
.NumberFormatLocal = "@"
'¡ô¥O³o½d³òÀx¦s®æ®æ¦¡¬O ¤å¦r
.Value = Arr
'¡ô¥O³o½d³òÀx¦s®æ¥HArr°}¦Cȼg¤JÀx¦s®æ¸Ì,¶W¹L³o½d³òªº°}¦CÈ©¿²¤
End With
End Sub |
|