Andy2483

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«¥H ­ã´£³¡ªL«e½ú½d¨Ò½m²ßVBA¤è®×,½Ð¦U¦ì«e½ú«ü±Ð
Xl0000094_20231122.zip (22.03 KB)

¤U¸ü¦¸¼Æ: 3

2023-11-22 09:07

°õ¦æµ²ªG:

¤U¸ü (151.4 KB)

2023-11-22 09:07

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 ½d³ò»P¶ZÂ÷_²M³æ()
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