ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

½Ð±ÐExcel¨ç¼Æ³]©w(vlook¡Bif)ªº°ÝÃD¡A¨Ã¥B±NÀÉ®×Åܧ󬰫ü©w®æ¦¡

¥Ñ©ó¸ê®Æ¶q«Ü¤j¡A»Ý­n³]©w¨ç¼ÆÅý¹q¸£¦Û¤v¥h³B²z¡A¥BµLªk³]¥¨¶°(¸ê®Æ¶q¤j¡A¶]¤ÓºC)

¤j¶q¸ê®Æ¡A¥Îvba¬O³Ì¦n¤èªk¡A¤£¹LµLªkÀH®É§ó·s¡A¦Ó¥Î«ö¶s³B²z¡A¦ý¤£²z¸Ñ¬°¦ó¡eµLªk³]¥¨¶°¡f¡H
­Y¥Î¤½¦¡¡A°£¤F¥Î¡e»²§UÄæ¡f¥i¥Hµy·LÀu¤Æ³t«×¡Aª½±µ°}¦C¤½¦¡·|¥d¬OµLªkÁקKªº¡I

TOP

Sub TEST()
Dim Arr, Brr, T$, N&, xD, Dr, X%, i&
Arr = Range([A1], Cells(Rows.Count, 2).End(xlUp))
ReDim Brr(1 To UBound(Arr), 1 To 200)
Set xD = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(Arr)
¡@¡@If Arr(i, 1) = "" Or Arr(i, 2) = "" Then GoTo 101
¡@¡@T = Arr(i, 1): Dr = xD(T)
¡@¡@If Not IsArray(Dr) Then N = N + 1: Dr = Array(N, 0): Brr(N, 1) = T
¡@¡@Dr(1) = Dr(1) + 1: If Dr(1) > X Then X = Dr(1)
¡@¡@Brr(Dr(0), Dr(1) + 1) = Arr(i, 2):  xD(T) = Dr
101: Next i
¡@
With [¤u§@ªí1!A1].Resize(N + 1, X + 1)
¡@¡@.Parent.UsedRange.Clear
¡@¡@.Cells(2, 1).Resize(N, X + 1) = Brr
¡@¡@.Item(1) = Arr(1, 1)
¡@¡@.Item(2).Resize(1, X) = "=""" & Arr(1, 2) & "-""&COLUMN(a1)"
¡@¡@.Borders.LineStyle = 1
¡@¡@Application.Goto .Item(1)
End With
End Sub
¡@
¼g±oÅo¶Û¨Ç¡A¥Î¬Ý¬Ý¡G
Xl0000127.rar (19.48 KB)
¡@

TOP

        ÀR«ä¦Û¦b : ¡i°µ¤Hªº¶}©l¡j¨C¤@¤Ñ³£¬O¬G¤Hªº¶}©l¡A¨C¤@­Ó®É¨è³£¬O¦Û¤vªºÄµ±§¡C
ªð¦^¦Cªí ¤W¤@¥DÃD