- ©«¤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
|
¦^´_ 1# wvsx
ÁÂÁ«e½úµoªí¦¹¥DÃD»P®×¨Ò
«á¾ÇÂǦ¹´£½m²ß°}¦C»P¦r¨å,Y«e½ú¦³¿³½ì!¥i¸Õ¸Õ¬Ý
¤ß±oµù¸Ñ¦p¤U!½Ð«e½úÌ«ü¥¿¨Ã«ü¾É!ÁÂÁÂ
°õ¦æ¿é¤Jµ¡:
°õ¦æµ²ªG:
Option Explicit
Sub ¹B¥Î¿é¤Jµ¡§äAÄæ³Ì±µªñ¼Æ¦r¨Ã¦bÀx¦s®æÅܶÀ©³¦â_1()
Dim Brr, T1, Y, A#, T#, i&, xA As Range, xR, U As Range
'¡ô«Å§iÅÜ¼Æ (Brr, T1, Y)¬O³q¥ÎÅܼÆ,(A,T)¬O¦³¤p¼ÆÂIÂùºë«×¼Æ¦r,(i)¬Oªø¾ã¼Æ,(xA,xR)¬OÀx¦s®æ
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥O Y¬O¦r¨å
xR = InputBox("½Ð¿é¤J¬d¸ß³Ì±µªñ¼Æ¦rªº°ò·Ç¼Æ¦r(¥i¦³¤p¼ÆÂI)", "¬dAÄæ³Ì±µªñ¼Æ¦r", 4786)
'¡ô¥OxR ¬O¶Ç¦^¦b¹ï¸Ü¤è¶ô¤¤¿é¤Jªº¸ê°T(¹ï¸Ü¤è¶ô´£¥Ü¤å¦r,¹ï¸Ü¤è¶ô¥ª¤W¨¤¤å¦r,¿é¤Jµ¡¹w³]¤å¦r)
If IsNumeric(xR) = False Then MsgBox "«D¼Æ¦rµLªk°õ¦æ!": Exit Sub
'¡ô¦pªGxR ³o¿é¤Jªº¤å¦r¸g§PÂ_¤£¬O¼Æ¦r,´NÅã¥Ü´£µøµ¡,¾Þ§@ªÌ«ö½T©w«á µ²§ôµ{¦¡°õ¦æ
Set xA = Range([A1], Cells(Rows.Count, "A").End(xlUp))
'¡ô¥OxA ¬O[A1]¨ìAÄæ³Ì«á¤@Ó¦³¤º®eÀx¦s®æ¤§¶¡ªº¦s®æ(ª«¥ó)
xA.Interior.ColorIndex = xlNone
'¡ô¥OxA ªº©³¦â¬OµL¦â
Brr = xA
'¡ô¥O¬O°}¦C! ˤJxAÀx¦s®æªºÈ
For i = 1 To UBound(Brr)
'¡ô³]¶¶°j°é!±q1 ¨ì Brr°}¦CÁa¦V³Ì¤j¦C¸¹
If IsNumeric(Brr(i, 1)) = False Or Brr(i, 1) = "" Then GoTo 111
'¡ô¦pªG°j°éBrr°}¦Cȸg¹L§PÂ_:¤£¬O¼Æ¦r ©Î ¬OªÅ¦r¤¸!´N¸õ¨ì 111¦ì¸mÄ~Äò°õ¦æ
Set U = Cells(i, 1)
'¡ô¥OU ¬Oª«¥ó(°j°éÀx¦s®æ)
T = Abs(Brr(i, 1) - xR)
'¡ô¥OT ¬O (°j°éBrr°}¦CÈ - °ò·Ç¼Æ¦r)¸g¹Lµ´¹ïȹBºâªº¼Æ¦r
T1 = T & "|"
'¡ô¥OT1 ¬OT³s±µ "|"²Å¸¹ªº¦r¦ê
If InStr(Y(T), Brr(i, 1) & " ") = 0 Then
'¡ô¥ÎTÅÜ¼Æ ·íkey¬dY¦r¨åitem,¦pªGitem¸Ì±¨S¦³¥]§t (°j°éBrr°}¦Cȳs±µ" "ªÅ¥Õ¦r)ªº¦r¦ê
Y(T) = IIf(Y.Exists(T) = Empty, " ", Y(T) & " " & Brr(i, 1))
'¡ô¥ÎTÅܼƷíkey,IIf§PÂ_¦¡¦^¶ÇªºÈ·íitem
'IIf§PÂ_¦¡:¥ÎTÅܼƷíkey¬d¹îY¦r¨å¸Ìªºitem¬O¤£¬Oªì©lÈ!,
'Y¥¿½T(" "),§_«h(Y(T) & " " & Brr(i, 1))
End If
If Y.Exists(T1) = Empty Then
'¡ô¦pªG¥ÎT1ÅܼƷíkey¬d¹îY¦r¨å¬Oªì©lÈ
Set Y(T1) = U
'¡ô¥OT1ÅܼƷíkey,item¬O ¬Oª«¥ó(°j°éÀx¦s®æ)!©ñ¤JY¦r¨å¸Ì
Else
Set Y(T1) = Union(Y(T1), U)
'¡ô§_«h!¥OY¦r¨å¸Ìkey¬OT1Åܼƪºitem¦A¯Ç¤J ª«¥ó(°j°éÀx¦s®æ)!
'¦¨¬°Àx¦s®æ¶°
End If
111
Next
A = WorksheetFunction.Min(Y.KEYS)
'¡ô¥OA ¬OY¦r¨å¸Ì±keyªº ³Ì¤pÈ
Y(A & "|").Interior.ColorIndex = 6
'¡ô¥Î ³Ì¤pȳs±µ "|"²Å¸¹·íkey¬d¹îY¦r¨å¸Ìªºitem,¥Oitemªº©³¦â¬O ¶À¦â
MsgBox Y(A)
'¡ô¥Î ³Ì¤pÈ·íkey¬d¹îY¦r¨å¸Ìªºitem!¦b´£¥Üµ¡Åã¥Ü
Set Brr = Nothing
Set Y = Nothing
'¡ô¥OBrr,Y ³o¨â®e¾¹±q°O¾ÐÅé¸ÌÄÀ©ñ±¼!
End Sub |
|