- 帖子
- 1447
- 主題
- 40
- 精華
- 0
- 積分
- 1471
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-12-5
|
8#
發表於 2023-11-22 09:08
| 只看該作者
謝謝論壇,謝謝各位前輩
後學藉此帖以 准提部林前輩範例練習VBA方案,請各位前輩指教
 Xl0000094_20231122.zip (22.03 KB)
執行結果:
Option Explicit
Function F20231122_1(ByVal Va$)
Application.Volatile
Evaluate "Ex()"
F20231122_1 = Va
End Function
Sub Ex()
Dim Arr, Brr, Crr, Z, A, i&, Mi#, Ma#, ii&, E#, V#
Set Arr = CreateObject("System.Collections.ArrayList")
Set Z = CreateObject("Scripting.Dictionary")
Brr = Range([F6], [C65536].End(3))
For i = 1 To UBound(Brr)
If Brr(i, 1) <> [I2] Or Brr(i, 2) <> [I3] Then GoTo i01 Else V = Brr(i, 3)
Z(V) = Val(Brr(i, 4))
Ma = IIf(Ma < V, V, Ma)
Mi = IIf(Mi = 0, Ma, IIf(Mi > V, V, Mi))
i01: Next
Brr = Range([I8], [I65536].End(3))
For i = 1 To UBound(Brr): Z(Val(Brr(i, 1))) = Z(Val(Brr(i, 1))): Next
For Each A In Z.Keys
If A <> vbNullString And Not Arr.contains(A) Then Arr.Add (A)
Next
Arr.Sort: Arr = Arr.toarray
For i = 0 To UBound(Arr)
V = Arr(i)
If V <= Mi Then Z(V) = Z(Mi): GoTo i02
If V >= Ma Then Z(V) = Z(Ma): GoTo i02
If Z(V) <> "" Then E = V
If Z(V) = "" Then
For ii = i + 1 To UBound(Arr)
A = Arr(ii)
If Z(A) <> "" Then
Z(V) = Z(E) + (Z(A) - Z(E)) * ((V - E) / (A - E)): Exit For
End If
Next
End If
i02: Next
For i = 1 To UBound(Brr): Brr(i, 1) = Z(Brr(i, 1)): Next
[K8].Resize(UBound(Brr)) = Brr: [I5] = Mi: [J5] = Ma
End Sub
Sub 範圍與距離_清單()
Dim Arr, Brr, Crr, Z, A, i&, Mi#, Ma#, ii&, E#, V#
Set Z = CreateObject("Scripting.Dictionary")
Brr = Range([D6], [C65536].End(3))
For i = 1 To UBound(Brr)
Z(Brr(i, 1)) = Brr(i, 2)
Next
With [I2].Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=Join(Z.Keys, ",")
End With
With [I3].Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=Join(Z.Items, ",")
End With
End Sub |
|
發表於 2021-2-6 10:35
| 
$111=I$3)),,2),OFFSET(E$5,MATCH(MAX(I$4,I8),E$6:E$111/(C$6:C$111=I$2)/(D$6