Andy2483

¦^´_ 1# wvsx


    ÁÂÁ«e½úµoªí¦¹¥DÃD»P®×¨Ò
«á¾ÇÂǦ¹´£½m²ß°}¦C»P¦r¨å,­Y«e½ú¦³¿³½ì!¥i¸Õ¸Õ¬Ý
¤ß±oµù¸Ñ¦p¤U!½Ð«e½ú­Ì«ü¥¿¨Ã«ü¾É!ÁÂÁÂ

°õ¦æ¿é¤Jµ¡:

¤U¸ü (164.87 KB)

2022-12-1 11:44

°õ¦æµ²ªG:

¤U¸ü (152.04 KB)

2022-12-1 11:44

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

Andy2483

¦^´_ 6# Andy2483


    ³o¬O«á¾Ç½m²ß°}¦C&¦r¨å¥Î¨ÓÅçÃÒªº¶Ã¼Æ½d¨Ò¤ß±oµù¸Ñ
½Ð«e½ú­Ì«ü¥¿¨Ã«ü¾É!ÁÂÁÂ
°õ¦æµ²ªG:

¤U¸ü (81.13 KB)

2022-12-1 14:08

Sub ¶Ã¼Æ¥¬°}()
'¦pªG­n°õ¦æ¦¹¶Ã¼Æ¥¬°}!½Ð¥ý¶}±Ò¤@­Ó·sªº¬¡­¶Ã¯°µ´ú¸Õ!
'¥H§K¯}Ãa¤F±zªº¦³®Ä¸ê®Æ!
Dim Brr(1000), i&, n&, Y
'¡ô«Å§iÅܼÆ
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥O Y¬O¦r¨å
For i = 0 To 10 ^ 3
'¡ô³]¶¶°j°é ±q0¨ì 1000
   n = Rnd() * 10 ^ 3 Mod 800
   '¡ô¥On ¬O¶Ã¼Æ(0~1)*1000 °£800ªº¾l¼ÆÂà¾ã¼Æ
   Y(n) = Y(n) + 1
   '¡ô¥OnÅܼƷíkey,item±q0 ¶}©l²Ö¥[ 1
   If Y(n) = 1 Then
   '¡ô¦pªG¥ÎnÅܼƷíkey ¬d¹îY¦r¨åªºitem¬O 1 ??
      Brr(i) = n
      '¡ô±ø¥ó¦¨¥ß´N¥O °j°éBrr°}¦C­È=nÅܼÆ
      ElseIf Y(n) = 2 Then
      '¡ô§_«h¦pªG¥ÎnÅܼƷíkey ¬d¹îY¦r¨åªºitem¬O 2 ??
         Brr(i) = -n
         '¡ô§_«hªº±ø¥ó¦¨¥ß´N¥O °j°éBrr°}¦C­È=nÅܼÆÅܦ¨­t¼Æ
      ElseIf Y(n) = 3 Then
      '¡ô§_«h¦pªG¥ÎnÅܼƷíkey ¬d¹îY¦r¨åªºitem¬O 3 ??
         Brr(i) = ""
         '¡ô§_«hªº±ø¥ó¦¨¥ß´N¥O °j°éBrr°}¦C­È¬OªÅ¦r¤¸
      Else
         Brr(i) = "NA"
         '¡ô§_«h´N¥O °j°éBrr°}¦C­È¬O "NA"¦r¦ê
   End If
Next
[A1].Resize(1001) = Application.Transpose(Brr)
'¡ô¥O[A1]Àx¦s®æ¦V¤UÂX®i1001¦CªºÀx¦s®æ½d³ò,¥HBrr°}¦CÂà¸m«á¥N¤J
Erase Brr
Set Y = Nothing
'¡ôÄÀ©ñÅܼÆ
End Sub

Andy2483

¦^´_ 7# Andy2483


  ½m²ß¦Û­q¸q¨ç¼Æ¤è¦¡

¤U¸ü (101.3 KB)

2022-12-1 16:48

¤U¸ü (95.58 KB)

2022-12-1 16:48

¤U¸ü (98.31 KB)

2022-12-1 16:48

¤U¸ü (104.59 KB)

2022-12-1 16:48

Option Explicit
Function ³Ì±µªñ¼Æ¦r(°ò·Ç¼Æ¦r As Double, ¤j©Î¤p As String, ½d³ò As Range)
Dim Brr, T1, Y, A#, T#, i&, xA As Range, xR, U As Range, M
'¡ô«Å§iÅÜ¼Æ (Brr, T1, Y)¬O³q¥ÎÅܼÆ,(A,T)¬O¦³¤p¼ÆÂIÂùºë«×¼Æ¦r,(i)¬Oªø¾ã¼Æ,(xA,xR)¬OÀx¦s®æ
Application.Volatile
'¡ô±N¨Ï¥ÎªÌ©w¸qªº¨ç¼Æ¼Ð¥Ü¬°©öÅÜ¡C
'¨C·í¤u§@ªí¤W¥ô¦óÀx¦s®æµo¥Í­pºâ®É¡A³£¥²¶·­«·s­pºâ©öÅܨç¼Æ¡C
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥O Y¬O¦r¨å
xR = °ò·Ç¼Æ¦r
If IsNumeric(xR) = False Then MsgBox "«D¼Æ¦rµLªk°õ¦æ!": Exit Function
'¡ô¦pªGxR ³o¿é¤Jªº¤å¦r¸g§PÂ_¤£¬O¼Æ¦r,´NÅã¥Ü´£µøµ¡,¾Þ§@ªÌ«ö½T©w«á µ²§ôµ{¦¡°õ¦æ
Set xA = ½d³ò
'¡ô¥OxA ¬O[A1]¨ìAÄæ³Ì«á¤@­Ó¦³¤º®eÀx¦s®æ¤§¶¡ªº¦s®æ(ª«¥ó)
Brr = xA
'¡ô¥O¬O°}¦C! ­Ë¤JxAÀx¦s®æªº­È
M = ¤j©Î¤p
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 = Brr(i, 1) - xR
   If (M = "¤p" And T > 0) Or (M = "¤j" And T < 0) Then GoTo 111
   '¡ô¥OT ¬O (°j°éBrr°}¦C­È - °ò·Ç¼Æ¦r)¸g¹Lµ´¹ï­È¹Bºâªº¼Æ¦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, "", Brr(i, 1))
   End If
   
111
Next
If M = "¤p" Then
   A = WorksheetFunction.Max(Y.KEYS)
   '¡ô¥OA ¬OY¦r¨å¸Ì­±keyªº ³Ì¤j­È
   ElseIf M = "¤j" Then
      A = WorksheetFunction.Min(Y.KEYS)
      '¡ô¥OA ¬OY¦r¨å¸Ì­±keyªº ³Ì¤p­È
End If
³Ì±µªñ¼Æ¦r = Y(A)
'¡ô¥Î ³Ì¤p­È·íkey¬d¹îY¦r¨å¸Ìªºitem!¦b´£¥Üµ¡Åã¥Ü
Set Brr = Nothing
Set Y = Nothing
'¡ô¥OBrr,Y ³o¨â®e¾¹±q°O¾ÐÅé¸ÌÄÀ©ñ±¼!
End Function