线性内插在很多时候都会用到，今天我们用VBA写个线性内插的小程序，日后我们在处理数据时就可以随时随地调出线性内插工具使用了。

这里有用到VBA中的窗体和模块，窗体设计如下图，附上代码。有需要的可私信“线性内插”获取窗体及模块。

创建自己的选项卡及将程序添加到选项卡中，参照文章【VBA小程序的添加——创建自己的选项卡】

线性内插窗体设计

窗体代码：

Public resultNumPrivate Sub CommandButton1_Click()x1 = TextBox1.Valuex2 = TextBox2.Valuey1 = TextBox3.Valuey2 = TextBox4.ValueX = TextBox5.Valuey = TextBox6.ValueIf x1 = "" Or x2 = "" Or y1 = "" Or y2 = "" Then MsgBox "请完善参数！", vbInformation, "提示": Exit SubIf X = "" And y = "" Then MsgBox "请输入X或Y值！", vbInformation, "提示": TextBox1.SetFocusElseIf 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 IfElseIf 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 IfElse MsgBox "请确保被求值为空！", vbInformation, "提示": TextBox5.SetFocusEnd IfApplication.ScreenUpdating = TrueEnd SubPrivate Sub CommandButton2_Click()Dim resultData As DataObjectSet resultData = New DataObjectresultData.SetText resultNumresultData.PutInClipboardSet resultData = NothingUnload MeEnd SubPrivate Sub TextBox1_AfterUpdate() 'X1If TypeName(Val(TextBox1.Value)) = "String" Then MsgBox "请输入数值", , "提示": TextBox1 = ""End SubPrivate Sub TextBox2_AfterUpdate() 'X2If TypeName(Val(TextBox2.Value)) = "String" Then MsgBox "请输入数值", , "提示": TextBox2 = ""End SubPrivate Sub TextBox3_AfterUpdate() 'Y1If TypeName(Val(TextBox3.Value)) = "String" Then MsgBox "请输入数值", , "提示": TextBox3 = ""End SubPrivate Sub TextBox4_AfterUpdate() 'Y2If TypeName(Val(TextBox4.Value)) = "String" Then MsgBox "请输入数值", , "提示": TextBox4 = ""End SubPrivate Sub TextBox5_AfterUpdate() 'XIf TypeName(Val(TextBox5.Value)) = "String" Then MsgBox "请输入数值", , "提示": TextBox5 = ""End SubPrivate Sub TextBox6_AfterUpdate() 'YIf TypeName(Val(TextBox6.Value)) = "String" Then MsgBox "请输入数值", , "提示": TextBox6 = ""End Sub

模块代码：

Sub 线性内插()Application.ScreenUpdating = False '//关闭屏幕刷新Application.DisplayAlerts = False '//关闭系统提示Application.EnableEvents = False '//禁止触发其他事件UserForm12.ShowApplication.EnableEvents = True '// '//恢复触发其他事件Application.ScreenUpdating = True '//恢复屏幕刷新Application.DisplayAlerts = True '//恢复系统提示End Sub