vb.net如何解方程 vb怎么解方程

提示：扫一扫查出行
【扫一扫了解最新限行尾号】
复制提示

用VB如何解方程式

你这个方程至少应该整理成ax+b=cvb.net如何解方程的形式吧

你这个是一元一次方程很简单vb.net如何解方程，是一条直线,用这个性质去解

先定义两个变量，设第一个变量为x1＝0vb.net如何解方程；如果a*x1+bc表示这个解比x1大，然后定义第二个变量x2＝100（随便假设）。再算。如果a*x2+bc表示这个解在x1和x2之间。再取其中点在运算，根据实际情况移动x1和x2，直到达到你要求的精度为止。

如果是二元以上的方程就很复杂了，要设计到线性的解法

相关问答

Q1: 怎么用VB解多元一次方程组

Public Function 解方程(增广矩阵() As Single, 解() As Single) As Boolean

Dim n As Integer, m As Integer, k As Integer, w As Single, 矩阵() As Single

Dim i As Integer, j As Integer

n = UBound(增广矩阵, 1)

m = UBound(增广矩阵, 2)

k = UBound(解)

If n k Or n + 1 m Then

MsgBox "增广矩阵的行列不匹配，或者与结果绝阵行数不匹配。", vbExclamation

解方程 = False

Exit Function

End If

ReDim 矩阵(n, m)

For i = 0 To n

For j = 0 To m

矩阵(i, j) = 增广矩阵(i, j)

Next j

Next i

For i = 0 To n

For j = i + 1 To n

If Abs(矩阵(i, i)) Abs(矩阵(j, i)) Then

For k = i To n + 1

w = 矩阵(i, k)

矩阵(i, k) = 矩阵(j, k)

矩阵(j, k) = w

Next k

End If

Next j

If 矩阵(i, i) = 0 Then

MsgBox "至少存在一组同构方程，该组方程无定解。", vbExclamation

解方程 = False

Exit Function

End If

For j = i + 1 To m

矩阵(i, j) = 矩阵(i, j) / 矩阵(i, i)

Next j

矩阵(i, i) = 1

For j = i + 1 To n

w = 矩阵(j, i)

For k = i To m

矩阵(j, k) = 矩阵(j, k) - 矩阵(i, k) * w

Next k

Next j

Next i

For i = n To 0 Step -1

w = 0

For j = i + 1 To n

w = w + 矩阵(i, j) * 解(j)

Next j

解(i) = (矩阵(i, m) - w) / 矩阵(i, i)

Next i

解方程 = True

End Function

Private Sub Command1_Click()

Dim n As Integer, a() As Single, x() As Single

n = InputBox("请输入方程组元数（未知数个数n）")

ReDim a(n - 1, n)

ReDim x(n - 1)

Print "给定方程组的增广矩阵为："

For i = 0 To n - 1

For j = 0 To n

a(i, j) = InputBox("输入系数矩阵A(" i + 1 "," j + 1 ")")

Print a(i, j);

Next j

Next i

If 解方程(a(), x()) Then

For k = 0 To n - 1

Print "x("; k + 1; ")"; "="; x(k)

Next k

End If

End Sub

Private Sub Form_Load()

Me.AutoRedraw = True

End Sub

Q2: 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 d0 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

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)

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 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 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 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

Q3: 如何用VB求一元二次方程的虚数解（一定是虚数解）。

vb代码如下：

Private Sub Command1_Click()

Dim a As Single, b As Single, c As Single

Dim d As Single, x1 As Single, x2 As Single

a = InputBox("请输入一元二次方程的系数a")

b = InputBox("请输入一元二次方程的系数b")

c = InputBox("请输入一元二次方程的系数c")

If a = 0 Then

a = InputBox("因为a≠0，你输入的a＝0，请重新输入系数a")

End If

d = b * b - 4 * a * c

If d = 0 Then

x1 = (-b + Sqr(d)) / (2 * a)

x2 = (-b - Sqr(d)) / (2 * a)

Print "系数为"; a; b; c; "的一元二次方程的根分别为"; x1

Print "系数为"; a; b; c; "的一元二次方程的根分别为"; x2

Else

Print "此方程在实数范围内无解"

End If

End Sub

一、按钮“求一元二次方程”的vb代码如下：

Private Sub Command1_Click()

a = Text1.Text

b = Text2.Text

c = Text3.Text

d = b * b - 4 * a * c

If d = 0 Then

X1 = (-b + Sqr(d)) / (2 * a)

X2 = (-b - Sqr(d)) / (2 * a)

Label4.Caption = X1

Label5.Caption = X2

Else

Label4.Caption = "在实数范围内无解"

End If

End Sub

二、按钮“重置”的vb代码如下：

Private Sub Command2_Click()

Text1.Text = ""

Text2.Text = ""

Text3.Text = ""

Label4.Caption = ""

Label5.Caption = ""

End Sub

三、按钮“退出”的vb代码如下：

Private Sub Command3_Click()

End

End Sub

特殊例子（指定系数c的值为5）：

在窗体“Form1.frm”的“Command1_click“事件中编写代码（请不要随便更改其它代码），使之能够实现如下功能：在Text1输入整数a、、Text2输入b，判断一元二次方程ax2+bx+5=0有无实数根。并在Text3文本框中显示判断结果，即有实数根则在Text3文本框中输出“有”，否则输出“无”。

VB程序代码如下：

Private Sub Command1_Click()

dim a as single,b as single

a = Text1.Text

b = Text2.Text

d = b * b - 4 * a * 5

If d = 0 Then

Text3.Text="有"

Else

Text3.Text="无"

End If

End Sub