[發問] 運用公式找出接近值的欄位

各位先進，請問如何運用公式找出接近值的欄位
假設 4786，要從A欄找出接近值，再對應欄位；A欄有包含空白的欄位
A
1 _
2 _
3 _
4 _
5 _
6 _
7 _
8 _
9 _
10 _
11 3,150
12 _
13 _
14 3,570
15 _
16 3,745
17 _
18 3,932
19 4,010
20 4,110
21 4,204
22 4,294
23 4,379
24 4,463
25 4,545
26 4,621
27 4,699
28 4,773
29 4,845
30 4,914
31 4,979
32 5,042
33 5,106
34 5,165
35 5,280
36 5,388
37 5,493
38 5,596
39 5,697
40 5,798
41 5,899
42 5,999
43 6,099
44 _
45 6,300

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1447
主題: 40
精華: 0
積分: 1471
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-12-5

8^#

發表於 2022-12-1 16:49 | 只看該作者

回復 7# Andy2483

練習自訂義函數方式

Option Explicit
Function 最接近數字(基準數字 As Double, 大或小 As String, 範圍 As Range)
Dim Brr, T1, Y, A#, T#, i&, xA As Range, xR, U As Range, M
'↑宣告變數 (Brr, T1, Y)是通用變數,(A,T)是有小數點雙精度數字,(i)是長整數,(xA,xR)是儲存格
Application.Volatile
'↑將使用者定義的函數標示為易變。
'每當工作表上任何儲存格發生計算時，都必須重新計算易變函數。
Set Y = CreateObject("Scripting.Dictionary")
'↑令 Y是字典
xR = 基準數字
If IsNumeric(xR) = False Then MsgBox "非數字無法執行!": Exit Function
'↑如果xR 這輸入的文字經判斷不是數字,就顯示提視窗,操作者按確定後結束程式執行
Set xA = 範圍
'↑令xA 是[A1]到A欄最後一個有內容儲存格之間的存格(物件)
Brr = xA
'↑令是陣列! 倒入xA儲存格的值
M = 大或小
For i = 1 To UBound(Brr)
'↑設順迴圈!從1 到 Brr陣列縱向最大列號
If IsNumeric(Brr(i, 1)) = False Or Brr(i, 1) = "" Then GoTo 111
'↑如果迴圈Brr陣列值經過判斷:不是數字或是空字元!就跳到 111位置繼續執行
Set U = Cells(i, 1)
'↑令U 是物件(迴圈儲存格)
T = Brr(i, 1) - xR
If (M = "小" And T > 0) Or (M = "大" And T < 0) Then GoTo 111
'↑令T 是 (迴圈Brr陣列值 - 基準數字)經過絕對值運算的數字
If InStr(Y(T), Brr(i, 1) & " ") = 0 Then
'↑用T變數當key查Y字典item,如果item裡面沒有包含 (迴圈Brr陣列值連接" "空白字)的字串
   Y(T) = IIf(Y.Exists(T) = Empty, "", Brr(i, 1))
End If

111
Next
If M = "小" Then
A = WorksheetFunction.Max(Y.KEYS)
'↑令A 是Y字典裡面key的最大值
ElseIf M = "大" Then
   A = WorksheetFunction.Min(Y.KEYS)
   '↑令A 是Y字典裡面key的最小值
End If
最接近數字 = Y(A)
'↑用最小值當key查察Y字典裡的item!在提示窗顯示
Set Brr = Nothing
Set Y = Nothing
'↑令Brr,Y 這兩容器從記憶體裡釋放掉!
End Function

TOP

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1447
主題: 40
精華: 0
積分: 1471
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-12-5

7^#

發表於 2022-12-1 14:11 | 只看該作者

回復 6# Andy2483

這是後學練習陣列&字典用來驗證的亂數範例心得註解
請前輩們指正並指導!謝謝
執行結果:

Sub 亂數布陣()
'如果要執行此亂數布陣!請先開啟一個新的活頁簿做測試!
'以免破壞了您的有效資料!
Dim Brr(1000), i&, n&, Y
'↑宣告變數
Set Y = CreateObject("Scripting.Dictionary")
'↑令 Y是字典
For i = 0 To 10 ^ 3
'↑設順迴圈從0到 1000
n = Rnd() * 10 ^ 3 Mod 800
'↑令n 是亂數(0~1)*1000 除800的餘數轉整數
Y(n) = Y(n) + 1
'↑令n變數當key,item從0 開始累加 1
If Y(n) = 1 Then
'↑如果用n變數當key 查察Y字典的item是 1 ??
   Brr(i) = n
   '↑條件成立就令迴圈Brr陣列值=n變數
   ElseIf Y(n) = 2 Then
   '↑否則如果用n變數當key 查察Y字典的item是 2 ??
      Brr(i) = -n
      '↑否則的條件成立就令迴圈Brr陣列值=n變數變成負數
   ElseIf Y(n) = 3 Then
   '↑否則如果用n變數當key 查察Y字典的item是 3 ??
      Brr(i) = ""
      '↑否則的條件成立就令迴圈Brr陣列值是空字元
   Else
      Brr(i) = "NA"
      '↑否則就令迴圈Brr陣列值是 "NA"字串
End If
Next
[A1].Resize(1001) = Application.Transpose(Brr)
'↑令[A1]儲存格向下擴展1001列的儲存格範圍,以Brr陣列轉置後代入
Erase Brr
Set Y = Nothing
'↑釋放變數
End Sub

TOP

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1447
主題: 40
精華: 0
積分: 1471
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-12-5

6^#

發表於 2022-12-1 11:51 | 只看該作者

回復 1# wvsx

謝謝前輩發表此主題與案例
後學藉此提練習陣列與字典,若前輩有興趣!可試試看
心得註解如下!請前輩們指正並指導!謝謝

執行輸入窗:

執行結果:

Option Explicit
Sub 運用輸入窗找A欄最接近數字並在儲存格變黃底色_1()
Dim Brr, T1, Y, A#, T#, i&, xA As Range, xR, U As Range
'↑宣告變數 (Brr, T1, Y)是通用變數,(A,T)是有小數點雙精度數字,(i)是長整數,(xA,xR)是儲存格
Set Y = CreateObject("Scripting.Dictionary")
'↑令 Y是字典
xR = InputBox("請輸入查詢最接近數字的基準數字(可有小數點)", "查A欄最接近數字", 4786)
'↑令xR 是傳回在對話方塊中輸入的資訊(對話方塊提示文字,對話方塊左上角文字,輸入窗預設文字)
If IsNumeric(xR) = False Then MsgBox "非數字無法執行!": Exit Sub
'↑如果xR 這輸入的文字經判斷不是數字,就顯示提視窗,操作者按確定後結束程式執行
Set xA = Range([A1], Cells(Rows.Count, "A").End(xlUp))
'↑令xA 是[A1]到A欄最後一個有內容儲存格之間的存格(物件)
xA.Interior.ColorIndex = xlNone
'↑令xA 的底色是無色
Brr = xA
'↑令是陣列! 倒入xA儲存格的值
For i = 1 To UBound(Brr)
'↑設順迴圈!從1 到 Brr陣列縱向最大列號
If IsNumeric(Brr(i, 1)) = False Or Brr(i, 1) = "" Then GoTo 111
'↑如果迴圈Brr陣列值經過判斷:不是數字或是空字元!就跳到 111位置繼續執行
Set U = Cells(i, 1)
'↑令U 是物件(迴圈儲存格)
T = Abs(Brr(i, 1) - xR)
'↑令T 是 (迴圈Brr陣列值 - 基準數字)經過絕對值運算的數字
T1 = T & "|"
'↑令T1 是T連接 "|"符號的字串
If InStr(Y(T), Brr(i, 1) & " ") = 0 Then
'↑用T變數當key查Y字典item,如果item裡面沒有包含 (迴圈Brr陣列值連接" "空白字)的字串
   Y(T) = IIf(Y.Exists(T) = Empty, " ", Y(T) & " " & Brr(i, 1))
   '↑用T變數當key,IIf判斷式回傳的值當item
   'IIf判斷式:用T變數當key查察Y字典裡的item是不是初始值!,
   '若正確(" "),否則(Y(T) & " " & Brr(i, 1))
End If
If Y.Exists(T1) = Empty Then
'↑如果用T1變數當key查察Y字典是初始值
   Set Y(T1) = U
   '↑令T1變數當key,item是是物件(迴圈儲存格)!放入Y字典裡
   Else
      Set Y(T1) = Union(Y(T1), U)
      '↑否則!令Y字典裡key是T1變數的item再納入物件(迴圈儲存格)!
      '成為儲存格集
End If

111
Next
A = WorksheetFunction.Min(Y.KEYS)
'↑令A 是Y字典裡面key的最小值
Y(A & "|").Interior.ColorIndex = 6
'↑用最小值連接 "|"符號當key查察Y字典裡的item,令item的底色是黃色
MsgBox Y(A)
'↑用最小值當key查察Y字典裡的item!在提示窗顯示
Set Brr = Nothing
Set Y = Nothing
'↑令Brr,Y 這兩容器從記憶體裡釋放掉!
End Sub

TOP

hcm19522