因为作业繁重，特写此来写作业，不过只能进行简单运算，暂不支持带有括号，常量尽量简单些
用的是公式法解方程，自动搜索简单的a,b,c带入公式法运算，得出结果
Option ExplicitPrivate Type Item '项ItemString As String '项的字符串 永远为正数Symbol As Long '符号(1=+ -1=- 2=* -2=/)Time As Long '项的次数CoefficIEnt As Single '项的系数UnkNown As String '未知数字符ConstItem As Boolean '是否为常数项(True是 False否)position As Boolean '位置是左(False)还是右(True)End Type'公式法'x=(-b±根号(b^2-4ac))/2aPublic Function Solving_Quadratics(ByVal Quadratics As String,ByRef x1 As Single,ByRef x2 As Single) As Long '解一元二次方程On Error Resume Next'一元二次方程式字符串 解1 解2'返回值: 0=无解 1=有两个相同的实数根 2=有两个不相同的实数根Dim QuaItem() As Item '方程式的项Dim leftItem() As Item '左边的项Dim RightItem() As Item '右边的项Dim QuaItemCount As Long '方程式的项数Dim leftItemCount As LongDim RightItemCount As LongDim leftOrRight As Boolean '是方程左边False还是右边TrueleftOrRight = False '首先遍历左边'-------------------------------------------------------------------------------------方程式正误检测BeginIf (Quadratics = "") Then '要解的方程式为空 Solving_Quadratics = 0 Exit FunctionEnd If'-------------------------------------------------------------------------------------方程式正误检测End'-------------------------------------------------------------------------------------去括号Begin'根据去括号法则,前面是-里面所有的项都要变号(+变- -变+) 前面是*就用乘法分配律 前面是/'-------------------------------------------------------------------------------------去括号End'-------------------------------------------------------------------------------------获取每一项存入Begin'+-为一项Dim i As LongDim Char As StringDim LastSymbolPlace As Long '上一个符号(+-)位置LastSymbolPlace = 1 '第一个自成一项For i = 0 To Len(Quadratics) - 1 '遍历每一个字符 Char = MID(Quadratics,i + 1,1) '取出这个字符 If (Char = "+") Or (Char = "-") Or (Char = "=") Then '成一项 ReDim Preserve QuaItem(QuaItemCount) QuaItem(QuaItemCount).ItemString = MID(Quadratics,LastSymbolPlace,i + 1 - LastSymbolPlace) '判断这一项的符号 Select Case MID(Quadratics,1) Case "+" QuaItem(QuaItemCount).Symbol = 1 QuaItem(QuaItemCount).ItemString = Right(QuaItem(QuaItemCount).ItemString,Len(QuaItem(QuaItemCount).ItemString) - 1) '去掉项的符号 Case "-" QuaItem(QuaItemCount).Symbol = -1 QuaItem(QuaItemCount).ItemString = Right(QuaItem(QuaItemCount).ItemString,Len(QuaItem(QuaItemCount).ItemString) - 1) Case "*" QuaItem(QuaItemCount).Symbol = 2 QuaItem(QuaItemCount).ItemString = Right(QuaItem(QuaItemCount).ItemString,Len(QuaItem(QuaItemCount).ItemString) - 1) Case "/" QuaItem(QuaItemCount).Symbol = -2 QuaItem(QuaItemCount).ItemString = Right(QuaItem(QuaItemCount).ItemString,Len(QuaItem(QuaItemCount).ItemString) - 1) Case Else '都不是就默认是+ And +号可以省略 QuaItem(QuaItemCount).Symbol = 1 End Select '获取这个项的次数 Dim TimePlace As Long '次数在这个项中的开始位置 TimePlace = InStr(1,QuaItem(QuaItemCount).ItemString,"^",vbTextCompare) '获取^的位置 If (TimePlace = 0) Then '没有找到^则说明默认是一次项 QuaItem(QuaItemCount).Time = 1 '一次项 Else '有^ 说明不是一次项 就获取次数 QuaItem(QuaItemCount).Time = MID(QuaItem(QuaItemCount).ItemString,TimePlace + 1,Len(QuaItem(QuaItemCount).ItemString) - TimePlace) QuaItem(QuaItemCount).ItemString = left(QuaItem(QuaItemCount).ItemString,Len(QuaItem(QuaItemCount).ItemString) - (Len(QuaItem(QuaItemCount).ItemString) - TimePlace) - 1) '去掉^ End If '判断是否为常数项 QuaItem(QuaItemCount).ConstItem = IsNumeric(QuaItem(QuaItemCount).ItemString) '判断是全数字 '获取这个项的系数 与 未知数 If (QuaItem(QuaItemCount).ConstItem = True) Then '是常数项 QuaItem(QuaItemCount).CoefficIEnt = Val(QuaItem(QuaItemCount).ItemString) '直接取得 Else '不是常数项 Dim ii As Long For ii = 0 To Len(QuaItem(QuaItemCount).ItemString) - 1 '循环遍历所有字符 If ((Asc(MID(QuaItem(QuaItemCount).ItemString,ii + 1,1)) < 41) Or (Asc(MID(QuaItem(QuaItemCount).ItemString,1)) > 57) Or (Asc(MID(QuaItem(QuaItemCount).ItemString,1)) = 44)) Then '不是运算符 QuaItem(QuaItemCount).CoefficIEnt = left(QuaItem(QuaItemCount).ItemString,ii + 1 - 1) '系数 QuaItem(QuaItemCount).UnkNown = Right(QuaItem(QuaItemCount).ItemString,Len(QuaItem(QuaItemCount).ItemString) - ii) '未知数 If (QuaItem(QuaItemCount).CoefficIEnt = 0) Then '系数为0(隐藏了系数1) QuaItem(QuaItemCount).CoefficIEnt = 1 '必须为1 End If End If Next ii End If '判断是左项还是右项 QuaItem(QuaItemCount).position = leftOrRight LastSymbolPlace = i + 1 '设置位置 QuaItemCount = QuaItemCount + 1 End If If (Char = "=") Then '换边 leftOrRight = Not leftOrRight '换边 LastSymbolPlace = i + 2 '设置=符号后一个(=不算入其内)位置 End IfNext i'结束后右项还有一个项没有算入 将最后一项加入ReDim Preserve QuaItem(QuaItemCount)QuaItem(QuaItemCount).ItemString = MID(Quadratics,i + 1 - LastSymbolPlace)Select Case MID(Quadratics,1)Case "+" QuaItem(QuaItemCount).Symbol = 1 QuaItem(QuaItemCount).ItemString = Right(QuaItem(QuaItemCount).ItemString,Len(QuaItem(QuaItemCount).ItemString) - 1)Case "-" QuaItem(QuaItemCount).Symbol = -1 QuaItem(QuaItemCount).ItemString = Right(QuaItem(QuaItemCount).ItemString,Len(QuaItem(QuaItemCount).ItemString) - 1)Case "*" QuaItem(QuaItemCount).Symbol = 2 QuaItem(QuaItemCount).ItemString = Right(QuaItem(QuaItemCount).ItemString,Len(QuaItem(QuaItemCount).ItemString) - 1)Case "/" QuaItem(QuaItemCount).Symbol = -2 QuaItem(QuaItemCount).ItemString = Right(QuaItem(QuaItemCount).ItemString,Len(QuaItem(QuaItemCount).ItemString) - 1)Case Else '都不是就默认是+ And +号可以省略 QuaItem(QuaItemCount).Symbol = 1End Select'获取这个项的次数TimePlace = InStr(1,vbTextCompare) '获取^的位置If (TimePlace = 0) Then '没有找到^则说明默认是一次项 QuaItem(QuaItemCount).Time = 1 '一次项Else '有^ 说明不是一次项 就获取次数 QuaItem(QuaItemCount).Time = MID(QuaItem(QuaItemCount).ItemString,Len(QuaItem(QuaItemCount).ItemString) - TimePlace) QuaItem(QuaItemCount).ItemString = left(QuaItem(QuaItemCount).ItemString,Len(QuaItem(QuaItemCount).ItemString) - (Len(QuaItem(QuaItemCount).ItemString) - TimePlace) - 1) '去掉^End If'判断是否为常数项QuaItem(QuaItemCount).ConstItem = IsNumeric(QuaItem(QuaItemCount).ItemString) '判断是全数字'获取这个项的系数 与 未知数If (QuaItem(QuaItemCount).ConstItem = True) Then '是常数项 QuaItem(QuaItemCount).CoefficIEnt = Val(QuaItem(QuaItemCount).ItemString) '直接取得Else '不是常数项 For ii = 0 To Len(QuaItem(QuaItemCount).ItemString) - 1 '循环遍历所有字符 If ((Asc(MID(QuaItem(QuaItemCount).ItemString,1)) < 42) Or (Asc(MID(QuaItem(QuaItemCount).ItemString,1)) = 44)) Then '不是数字 QuaItem(QuaItemCount).CoefficIEnt = left(QuaItem(QuaItemCount).ItemString,ii + 1 - 1) '系数 QuaItem(QuaItemCount).UnkNown = Right(QuaItem(QuaItemCount).ItemString,Len(QuaItem(QuaItemCount).ItemString) - ii) '未知数 If (QuaItem(QuaItemCount).CoefficIEnt = 0) Then '系数为0(隐藏了系数1) QuaItem(QuaItemCount).CoefficIEnt = 1 '必须为1 End If End If Next iiEnd IfQuaItem(QuaItemCount).position = leftOrRight '获取位置QuaItemCount = QuaItemCount + 1'-------------------------------------------------------------------------------------获取每一项存入End'-------------------------------------------------------------------------------------移项 化为标准形式Begin'标准形式为ax^2+bx+c=0Dim a As SingleDim b As SingleDim c As Single'将次数相同未知数的项进行运算并移项Dim TmpItem As Item '缓存'运算所有常量项与第三个项交换位置Dim ConstString As String '保存找到的常量项Dim ConstNumber As Long '保存常量运算结果'提取所有常量项For i = 0 To UBound(QuaItem) If (QuaItem(i).ConstItem = True) Then '是常数项 If (QuaItem(i).position = False) Then '这个项在左边 If (QuaItem(i).Symbol = 1) Then '+ ConstString = ConstString & "+" & QuaItem(i).CoefficIEnt '获取系数 Else '- ConstString = ConstString & "-" & QuaItem(i).CoefficIEnt End If Else '这个项在右边 '移项变号 QuaItem(i).Symbol = -QuaItem(i).Symbol '变号 If (QuaItem(i).Symbol = 1) Then '+ ConstString = ConstString & "+" & QuaItem(i).CoefficIEnt '获取系数 Else '- ConstString = ConstString & "-" & QuaItem(i).CoefficIEnt End If End If End IfNext i'运算所有常量项ConstNumber = MyMainCount(ConstString)'记录常量c = Val(ConstNumber)ConstString = ""Dim UnkNown As StringFor i = 0 To UBound(QuaItem) If (QuaItem(i).ConstItem = False) And (QuaItem(i).Time = 1) And (QuaItem(i).UnkNown <> "") Then '不是常数项 次数为1 有未知数 If (QuaItem(i).position = False) Then '这个项在左边 UnkNown = QuaItem(i).UnkNown '获取未知数 If (QuaItem(i).Symbol = 1) Then '+ ConstString = ConstString & "+" & QuaItem(i).CoefficIEnt '获取系数 Else '- ConstString = ConstString & "-" & QuaItem(i).CoefficIEnt End If Else '这个项在右边 '移项变号 QuaItem(i).Symbol = -QuaItem(i).Symbol '变号 If (QuaItem(i).Symbol = 1) Then '+ ConstString = ConstString & "+" & QuaItem(i).CoefficIEnt '获取系数 Else '- ConstString = ConstString & "-" & QuaItem(i).CoefficIEnt End If End If End IfNext iConstNumber = MyMainCount(ConstString) '获取一次项运算结果b = Val(ConstNumber)'运算所有二次项与第一个项交换位置ConstString = ""For i = 0 To UBound(QuaItem) If (QuaItem(i).ConstItem = False) And (QuaItem(i).Time = 2) And (QuaItem(i).UnkNown <> "") Then '不是常数项 次数为2 有未知数 If (QuaItem(i).position = False) Then '这个项在左边 UnkNown = QuaItem(i).UnkNown '获取未知数 If (QuaItem(i).Symbol = 1) Then '+ ConstString = ConstString & "+" & QuaItem(i).CoefficIEnt '获取系数 Else '- ConstString = ConstString & "-" & QuaItem(i).CoefficIEnt End If Else '这个项在右边 '移项变号 QuaItem(i).Symbol = -QuaItem(i).Symbol '变号 If (QuaItem(i).Symbol = 1) Then '+ ConstString = ConstString & "+" & QuaItem(i).CoefficIEnt '获取系数 Else '- ConstString = ConstString & "-" & QuaItem(i).CoefficIEnt End If End If End IfNext iConstNumber = MyMainCount(ConstString) '获取二次项运算结果a = Val(ConstNumber)'-------------------------------------------------------------------------------------移项 化为标准形式End'-------------------------------------------------------------------------------------判断解并带入公式求解 Begin'返回值: 0=无解 1=有两个相同的实数根 2=有两个不相同的实数根Dim Dt As Double '检验Dt = b ^ 2 - 4 * a * cIf (Dt < 0) Then '没有解 Solving_Quadratics = 0 Exit Function '不进行求根End IfIf (Dt = 0) Then '有两个相同的解 Solving_Quadratics = 1 x1 = (-b + Sqr(b ^ 2 - 4 * a * c)) / (2 * a) x2 = x1 '相同解 Exit FunctionEnd IfIf (Dt > 0) Then '有两个不相同的解 Solving_Quadratics = 2 x1 = (-b + Sqr(b ^ 2 - 4 * a * c)) / (2 * a) x2 = (-b - Sqr(b ^ 2 - 4 * a * c)) / (2 * a) Exit FunctionEnd If'-------------------------------------------------------------------------------------判断解并带入公式求解 EndEnd FunctionPublic Function MyMainCount(ByVal Str As String) As Long 'Str可带括号'支持+,-,*,/,()'先从()算起 从左至右Dim Str1 As StringDim Count As Long '整个算式的结果Dim i As LongDim bracket As Long '括号位置bracket = 1 '从第一个Count = 0For i = 0 To Len(Str) '循环检测是否有括号 bracket = InStr(bracket,Str,"(",vbTextCompare) If bracket = 0 Then '没有括号 Count = MyCount(Str) Else '有括号 '先算括号里面的 Str1 = MID(Str,bracket + 1,InStr(bracket,")",vbTextCompare) - 2) '分解出括号里面的 无括号 Count = Count + MyCount(Str1) Str = Replace(Str,"(" & Str1 & ")",CStr(Count),vbTextCompare) '将原来字符串中的()中的内容替换为运算后的得数 Count = 0 '只是为了将括号去掉 所以不记返回值 End If bracket = bracket + 1 '当前括号已经运算所以作废 先前移动一个字符Next iMyMainCount = CountEnd FunctionPublic Function MyCount(ByVal Str As String) As Long 'Str不可带括号 四舍五入制On Error Resume NextDim i As Long'判断有几个符号(数字=符号数量+1)Dim sym As Long '符号数量sym = 0For i = 0 To Len(Str) If MID(Str,1) = "+" Or MID(Str,1) = "-" Or MID(Str,1) = "*" Or MID(Str,1) = "/" Then sym = sym + 1 End IfNext i'提出所有数字存入数组 提出所有符号存入到数组Dim number() As Long '数字数组Dim numbercount As Long '数字总数Dim tmpbuffer As String '缓冲数组字符区ReDim number(sym) '动态设置数组维数'-------------------------------------------Dim symstring() As String '符号数组ReDim symstring(sym - 1) '动态设置数组维数Dim symcount As Long '符号总数numbercount = 0symcount = 0'开头不能是符号For i = 0 To Len(Str) - 1 If Asc(MID(Str,1)) >= &H30 And Asc(MID(Str,1)) <= &H39 Then '是0~9的Ascii码 tmpbuffer = tmpbuffer & MID(Str,1) '添加到缓冲区 Else '是运算符 number(numbercount) = Val(tmpbuffer) '将缓冲区输入到数组 numbercount = numbercount + 1 '数字总数+1 tmpbuffer = "" '清空运算符 供下次使用 '将运算符输入到数组 symstring(symcount) = MID(Str,1) symcount = symcount + 1 End IfNext i'将最后一个(结尾为数字)数组提出number(numbercount) = Val(tmpbuffer) '将缓冲区输入到数组numbercount = numbercount + 1 '数字总数+1tmpbuffer = "" '清空运算符 供下次使用'--------------------------------------------'开始运算'没有括号(不同级:先*/再+-)(同级:从左到右)'运算符有几个就算几次'Dim Level As Long '1=乘除级别 0=加减级别Dim ii As Long'Level = 0'For i = 0 To symcount - 1 '判断是否有乘除符号' '找乘除' If symstring(i) = "/" Or symstring(i) = "*" Then '有乘除' Level = 1 '乘除级别' Exit For' End If'Next i '先乘除后加减------------------------------------------------------------- '乘除从左到右 For i = 0 To symcount - 1 If i > symcount - 1 Then '超出范围了 Exit For End If If symstring(i) = "/" Or symstring(i) = "*" Then '乘法Or除法 If symstring(i) = "/" Then '没有算的最左边的/符号 开始进行除法运算 number(i) = number(i) / number(i + 1) '除法运算 End If If symstring(i) = "*" Then '没有算的最左边的*符号 开始进行乘法运算 number(i) = number(i) * number(i + 1) '除法运算 End If '数字数组减少一个 缺了一个空补上 For ii = i + 1 To numbercount - 1 number(ii) = number(ii + 1) '替换 Next ii numbercount = numbercount - 1 ReDim Preserve number(numbercount - 1) '保留+重定义 '符号数组减少一个 For ii = i + 1 To symcount - 1 symstring(ii - 1) = symstring(ii) Next ii symcount = symcount - 1 ReDim Preserve symstring(symcount - 1) i = i - 1 '回滚 End If Next i '加减从左到右 For i = 0 To symcount - 1 If i > symcount - 1 And symcount < 1 Then '超出范围了并且没有运算符号了就退出循环(不用运算了) Exit For Else '其中有一个为False特别是第二个就说明还有一个运算符 还要运算一次 所以将第一个与第二个进行运算 If i > symcount - 1 Then i = 0 '设置数组元素第1个 End If End If If symstring(i) = "+" Or symstring(i) = "-" Then '加法Or减法 If symstring(i) = "+" Then '没有算的最左边的/符号 开始进行除法运算 number(i) = number(i) + number(i + 1) '加法运算 End If If symstring(i) = "-" Then '没有算的最左边的*符号 开始进行乘法运算 number(i) = number(i) - number(i + 1) '减法运算 End If '数字数组减少一个 缺了一个空补上 For ii = i + 1 To numbercount - 1 number(ii) = number(ii + 1) '替换 Next ii numbercount = numbercount - 1 ReDim Preserve number(numbercount - 1) '保留+重定义 '符号数组减少一个 For ii = i + 1 To symcount - 1 symstring(ii - 1) = symstring(ii) Next ii symcount = symcount - 1 ReDim Preserve symstring(symcount - 1) i = i - 1 End If Next i'-----------------------------------------------------------------------------------------------MyCount = number(0) '返回结果(数组的第一个元素) 因为前面删除了空出来的元素 最后只剩下答案了End Function 总结 以上是内存溢出为你收集整理的VB解一元二次方程式全部内容，希望文章能够帮你解决VB解一元二次方程式所遇到的程序开发问题。
如果觉得内存溢出网站内容还不错，欢迎将内存溢出网站推荐给程序员好友。
欢迎分享，转载请注明来源：内存溢出
微信扫一扫
支付宝扫一扫
评论列表（0条）