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
$111=I$3)),,2),OFFSET(E$5,MATCH(MAX(I$4,I8),E$6:E$111/(C$6:C$111=I$2)/(D$6