- ©«¤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
|
ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,½m²ß¤£¨Ï¥ÎkeysÂà¸mµ²ªG,¦Ó¥Hµ²ªG¸ê®ÆÂл\ì°}¦C¸ê®Æ,¦A±Nµ²ªG¼g¤JÀx¦s®æ,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð
Option Explicit
Sub TEST_1()
Dim Brr, Y, i&, R&, T$, P$, xR As Range
Set Y = CreateObject("Scripting.Dictionary")
Set xR = [»Ý¨D»¡©ú1!A1].CurrentRegion: Brr = xR
For i = 2 To UBound(Brr)
P = Brr(i, 1)
T = Switch((T <> P) * (P <> ""), P, P = "", T)
If T = "" Then GoTo i01
If Y(T) = "" Then
Y(T) = Y.Count + 1: Brr(Y(T), 1) = T: Brr(Y(T), 2) = Brr(i, 2): GoTo i01
End If
R = Y(T): Brr(R, 2) = Replace(Trim(Brr(R, 2) & " " & Brr(i, 2)), " ", vbLf)
i01: Next
[J1].Resize(Y.Count + 1, 2) = Brr
Set Y = Nothing: Set xR = Nothing: Erase Brr
End Sub |
|