VB解方程 VB 计算e的x次方 vb函数大全

解一元一次方程： 设置4个文本框，分别代表一元一次方程中的参数k,b,x,y 分别命名txtk,txtb,txtx,txty.计算按钮命名为cmdCalc。 在代码窗口里粘贴如下代码: Private Sub cmdCalc_Click() Dim k, b As Long k = txtk.Text b = txtb.Text If txtx.Text = "x" Then MsgBox "x的值为:" & (txty.Text - b) / k ElseIf txty.Text = "y" Then MsgBox "y的值为:" & k * txtx.Text + b End If End Sub 计算时求x则在txtx那里输入一个x， 求y则在txty那里输入一个y， 在各文本框中输入参数， 然后按下按钮， 就有提示框弹出，显示结果。 一元二次方程： privat sub command1_click() dim a,b,c,x1,x2,d as sigle a=val(textl.text) b=val(text2.text) c=val(text3.text) d=b^2-4*a*c if d>0 then x1=(-b+sqr(d))/(2*a) x2=(-b-sqr(d))/(2*a) else if d=0 then x1=(-b/2*a) x2=x1 else msgbox"方程没有实根" end if text4.text="x1=" & x1 & "" & "x2=" & x2 end sub sub min(byref a() as integer) dim i,j as interger for i=1 to 9 for j=i+1 to 10 if a a(i)>a(j) then t=a(j) a(i)=a(j) a(j)=t end if next next end sub private sub command_(click) dim b(1 to 10) as interger dim a(1 to 10) as interger randomize for i=1 to 10 a(i)=int(rnd*90)+10 list1.additem a(i) b(i)=int(rnd*90)+ 10 list2.additem b(i) next call min(a) call min(b) if a(1)<b(1) then m=a(1) else m=b(1) end if text1.text="A,B种的最小值：" & vbcrlf & m end sub 一元三次方程： 针对方程"ax^3+bx^2+cx+d=0"的求根程序。 控件只需一个Command1，结果显示在“立即”中。 代码如下。（参考） ======================== Private Sub Command1_Click() Dim x1r As Double, x1i As Double, x2r As Double, x2i As Double, x3r As Double, x3i As Double Dim ret As String Const eq = "ax^3+bx^2+cx+d=0" a = InputBox("请输入a", eq) b = InputBox("请输入b", eq) c = InputBox("请输入c", eq) d = InputBox("请输入d", eq) ret = CubicEquation(a, b, c, d, x1r, x1i, x2r, x2i, x3r, x3i) '5x^3+4x^2+3x-12=0 Debug.Print "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" & ret Debug.Print x1r; " + "; x1i; " i" Debug.Print x2r; " + "; x2i; " i" Debug.Print x3r; " + "; x3i; " i" End Sub Private Function CubicEquation _ (ByVal a As Double, ByVal b As Double, ByVal c As Double, ByVal d As Double, _ x1r As Double, x1i As Double, x2r As Double, x2i As Double, x3r As Double, x3i As Double) As String 'Cubic equation(v2.2), coded by www.dayi.net btef (please let this line remain) Dim e As Double, f As Double, g As Double, h As Double, delta As Double Dim r As Double, sita As Double, pi As Double, rr As Double, ri As Double If a = 0 Then CubicEquation = "Not a cubic equation: a = 0" Exit Function End If 'pi = 3.14159265358979 pi = 4 * Atn(1) b = b / a 'simplify to a=1: x^3+bx^2+cx+d=0 c = c / a d = d / a e = -b ^ 2 / 3 + c 'substitute x=y-b/3: y^3+ey+f=0 f = (2 * b ^ 2 - 9 * c) * b / 27 + d If e = 0 And f = 0 Then x1r = -b / 3 x2r = x1r x3r = x1r CubicEquation = "3 same real roots:" ElseIf e = 0 Then 'need to deal with e = 0, or it will cause z = 0 later. r = -f 'y^3+f=0, y^3=-f r = Cur(r) x1r = r - b / 3 'a real root If r > 0 Then 'r never = 0 since g=f/2, f never = 0 there sita = 2 * pi / 3 x2r = r * Cos(sita) - b / 3 x2i = r * Sin(sita) Else sita = pi / 3 x2r = -r * Cos(sita) - b / 3 x2i = -r * Sin(sita) End If x3r = x2r x3i = -x2i CubicEquation = "1 real root and 2 image roots:" Else 'substitute y=z-e/3/z: (z^3)^2+fz^3-(e/3)^3=0, z^3=-g+sqr(delta) g = f / 2 '-q-sqr(delta) is ignored h = e / 3 delta = g ^ 2 + h ^ 3 If delta < 0 Then r = Sqr(g ^ 2 - delta) sita = Argument(-g, Sqr(-delta)) 'z^3=r(con(sita)+isin(sita)) r = Cur(r) rr = r - h / r sita = sita / 3 'z1=r(cos(sita)+isin(sita)) x1r = rr * Cos(sita) - b / 3 'y1=(r-h/r)cos(sita)+i(r+h/r)sin(sita), x1=y1-b/3 sita = sita + 2 * pi / 3 'no image part since r+h/r = 0 x2r = rr * Cos(sita) - b / 3 sita = sita + 2 * pi / 3 x3r = rr * Cos(sita) - b / 3 CubicEquation = "3 real roots:" Else 'delta >= 0 r = -g + Sqr(delta) r = Cur(r) rr = r - h / r ri = r + h / r If ri = 0 Then CubicEquation = "3 real roots:" Else CubicEquation = "1 real root and 2 image roots:" End If x1r = rr - b / 3 'a real root If r > 0 Then 'r never = 0 since g=f/2, f never = 0 there sita = 2 * pi / 3 x2r = rr * Cos(sita) - b / 3 x2i = ri * Sin(sita) Else 'r < 0 sita = pi / 3 x2r = -rr * Cos(sita) - b / 3 x2i = -ri * Sin(sita) End If x3r = x2r x3i = -x2i End If End If End Function Private Function Cur(v As Double) As Double If v < 0 Then Cur = -(-v) ^ (1 / 3) Else Cur = v ^ (1 / 3) End If End Function Private Function Argument(a As Double, b As Double) As Double Dim sita As Double, pi As Double 'pi = 3.14159265358979 pi = 4 * Atn(1) If a = 0 Then If b >= 0 Then Argument = pi / 2 Else Argument = -pi / 2 End If Else sita = Atn(Abs(b / a)) If a > 0 Then If b >= 0 Then Argument = sita Else Argument = -sita End If ElseIf a < 0 Then If b >= 0 Then Argument = pi - sita Else Argument = pi + sita End If End If End If End Function 二元一次方程： Dim a, b, c As Integer Dim x, y As Single Dim d As Double a = Val(InputBox("输入二次项系数")) b = Val(InputBox("输入一次项系数")) c = Val(InputBox("输入常数项")) d = b ^ 2 - 4 * a * c If d < 0 Then MsgBox "方程无解" ElseIf d = 0 Then x = -b / (2 * a) MsgBox "方程有一个解：" & x Else x = (-b + Sqr(d)) / (2 * a) y = (-b - Sqr(d)) / (2 * a) MsgBox "方程有两个解：" & x & "和" & y End If 三元一次方程： 方程组如下, ax+by+cz=d a'x+b'y+c'z=d' a"x+b"y+c"z=d" 其中x,y,z为未知数,a,a',a",b,b',b",c,c',c",d,d',d",为用户输入的数值 解N元一次方程，indat为N+1行、N列的数组，outdat为N个元素的数组 Public Sub 解方程(ByRef InDat() As Double, ByVal InDatCount As Long, ByRef OutDat() As Double, ByRef OutDatCount As Long) Dim Xt() As Double Dim Dt As Double Dim Ss As Long Dim OtSCount As Long Dim XtOut() As Double If InDatCount > 1 Then ReDim Xt(1 To InDatCount - 1, 1 To InDatCount) As Double For j = 1 To InDatCount - 1 '行 For i = 2 To InDatCount + 1 '列 Xt(j, i - 1) = InDat(j, i) * InDat(InDatCount, 1) / InDat(1, 1) - InDat(InDatCount, i) Next i Next j OtSCount = 0 解方程 Xt, InDatCount - 1, XtOut, OtSCount Dt = 0 For i = 1 To InDatCount - 1 Dt = Dt + InDat(InDatCount, i + 1) * XtOut(i) Next i Dt = Dt + InDat(InDatCount, i + 1) ReDim Preserve OutDat(1 To 1 + OtSCount) As Double OutDat(1) = -Dt / InDat(InDatCount, 1) For i = 2 To OtSCount + 1 OutDat(i) = XtOut(i - 1) Next i OutDatCount = 1 + OtSCount Else ReDim OutDat(1 To 1) As Double If InDat(1, 1) <> 0 Then OutDat(1) = -InDat(1, 2) / InDat(1, 1) Else OutDat(1) = 0 End If OutDatCount = 1 End If End Sub

VB 计算e的x次方

vb提供了指数函数：exp（x），就是用来计算e的x次方的。 所以代码可以简化为： Private Sub Form_Click() Dim x As Integer, a As Double x = Val(InputBox("请输入X的值")) a=exp(x) Print "e^x =" & a End Sub 答案补充： 错误在于对Loop While x ^ n / jc(n) < 0.000001的理解，while是当……的时候继续循环，所以你的循环执行了一次，，这时候，因为新增值大于允许误差而提前结束了循环。在第一次循环里，因为n=1，阶乘结果也是1，导致整数结果。 修改：将循环条件的逻辑运算符倒过来，或者将while换成until。 另外，这样的计算仍存在缺陷，就是溢出！当n=13的时候，n！就会溢出。导致出错，所以，在循环条件里再加一个关于n的。 综合以上，代码可以写为： Private Sub Form_Click() Dim x As Integer, a As Double x = Val(InputBox("请输入X的值")) a = 1 Do n = n + 1 新值 = x ^ n / jc(n) a = a + 新值 Loop While 新值 > 0.000001 And n < 11 Print "e^x =" & a End Sub Function jc(n) Dim i As Integer, f As Long f = 1 For i = 1 To n f = f * i Next i jc = f End Function 以上是VB解方程 VB 计算e的x次方 vb函数大全的全部内容，想了解更多汽车知识相关内容，请关注智配网。