线性内插在很多时候都会用到，今天我们用VBA写个线性内插的小程序，日后我们在处理数据时就可以随时随地调出线性内插工具使用了。
这里有用到VBA中的窗体和模块，窗体设计如下图，附上代码。有需要的可私信“线性内插”获取窗体及模块。
创建自己的选项卡及将程序添加到选项卡中，参照文章【VBA小程序的添加——创建自己的选项卡】
线性内插窗体设计
窗体代码：
Public resultNum Private Sub CommandButton1_Click() x1 = TextBox1.Value x2 = TextBox2.Value y1 = TextBox3.Value y2 = TextBox4.Value X = TextBox5.Value y = TextBox6.Value If x1 = "" Or x2 = "" Or y1 = "" Or y2 = "" Then MsgBox "请完善参数！", vbInformation, "提示": Exit Sub If X = "" And y = "" Then MsgBox "请输入X或Y值！", vbInformation, "提示": TextBox1.SetFocus ElseIf X = "" Then If y2 = y1 Then MsgBox "Y1与Y2不能为同一值！", vbInformation, "提示": TextBox3.SetFocus Else If TypeName(x1) = "String" Then x1 = Val(x1) If TypeName(x2) = "String" Then x2 = Val(x2) If TypeName(y1) = "String" Then y1 = Val(y1) If TypeName(y2) = "String" Then y2 = Val(y2) If TypeName(y) = "String" Then y = Val(y) X = x1 + (x2 - x1) / (y2 - y1) * (y - y1) Me.TextBox5.Value = X resultNum = X End If ElseIf y = "" Then If x2 = x1 Then MsgBox "X1与X2不能为同一值！", vbInformation, "提示": TextBox1.SetFocus Else If TypeName(x1) = "String" Then x1 = Val(x1) If TypeName(x2) = "String" Then x2 = Val(x2) If TypeName(y1) = "String" Then y1 = Val(y1) If TypeName(y2) = "String" Then y2 = Val(y2) If TypeName(X) = "String" Then X = Val(X) y = y1 + (y2 - y1) / (x2 - x1) * (X - x1) Me.TextBox6.Value = y resultNum = y End If Else MsgBox "请确保被求值为空！", vbInformation, "提示": TextBox5.SetFocus End If Application.ScreenUpdating = True End Sub Private Sub CommandButton2_Click() Dim resultData As DataObject Set resultData = New DataObject resultData.SetText resultNum resultData.PutInClipboard Set resultData = Nothing Unload Me End Sub Private Sub TextBox1_AfterUpdate() ’X1 If TypeName(Val(TextBox1.Value)) = "String" Then MsgBox "请输入数值", , "提示": TextBox1 = "" End Sub Private Sub TextBox2_AfterUpdate() ’X2 If TypeName(Val(TextBox2.Value)) = "String" Then MsgBox "请输入数值", , "提示": TextBox2 = "" End Sub Private Sub TextBox3_AfterUpdate() ’Y1 If TypeName(Val(TextBox3.Value)) = "String" Then MsgBox "请输入数值", , "提示": TextBox3 = "" End Sub Private Sub TextBox4_AfterUpdate() ’Y2 If TypeName(Val(TextBox4.Value)) = "String" Then MsgBox "请输入数值", , "提示": TextBox4 = "" End Sub Private Sub TextBox5_AfterUpdate() ’X If TypeName(Val(TextBox5.Value)) = "String" Then MsgBox "请输入数值", , "提示": TextBox5 = "" End Sub Private Sub TextBox6_AfterUpdate() ’Y If TypeName(Val(TextBox6.Value)) = "String" Then MsgBox "请输入数值", , "提示": TextBox6 = "" End Sub
模块代码：
Sub 线性内插() Application.ScreenUpdating = False ’//关闭屏幕刷新 Application.DisplayAlerts = False ’//关闭系统提示 Application.EnableEvents = False ’//禁止触发其他事件 UserForm12.Show Application.EnableEvents = True ’// ’//恢复触发其他事件 Application.ScreenUpdating = True ’//恢复屏幕刷新 Application.DisplayAlerts = True ’//恢复系统提示 End Sub