VBScript 大数除法溢出，具体如何修正？ - VB6论坛

楼主

已结贴√ 问题点数：20 回复次数：5

VBScript 大数除法溢出，具体如何修正？

程序代码：

' 大数除法，x > y
Function BigNumDiv(x, y)
Dim r, quotient, remainder, temp, temp1, temp2
Dim lenx, leny
Dim i, j
lenx = Len(x)
leny = Len(y)
If lenx < leny Then
BigNumDiv = "0"
Exit Function
End If
quotient = ""
r = Mid(x, 1, leny)
For i = leny + 1 To lenx
If r = "0" Then r = Mid(x, i, 1) Else r = r & Mid(x, i, 1)
quotient = quotient & "0"
j = 1
Do While BigNumSub(r, y) <> "" And CLng(BigNumSub(r, y)) >= 0
r = BigNumSub(r, y)
j = j + 1
Loop
quotient = Left(quotient, Len(quotient) - 1) & j - 1
Next
While Len(quotient) > 1 And Left(quotient, 1) = "0"
quotient = Right(quotient, Len(quotient) - 1)
Wend
If Len(quotient) = 0 Then quotient = "0"
While Len(r) > 1 And Left(r, 1) = "0"
r = Right(r, Len(r) - 1)
Wend
remainder = r
BigNumDiv = quotient
End Function

MsgBox BigNumDiv("12193263113702179556720073558516635681494230864252625391052410", "987654321098765432109876543210")  '显示 123456789012345678901234567890

会的麻烦修正，感谢！

搜索更多相关主题的帖子: 除法　 And　大数　 If　Then　

第 2 楼

得分:0

一、CLng(BigNumSub(r, y)) >= 0 会溢出，两个大数的差可能也是一个巨大的数，无法转换为Long，应该另外写一个判断大小的函数来比较大小，可以这样定义：
Function BigNumCmp(x, y) '根据 x 与 y 的大小，返回1、0、-1

二、用减法来实现除法会把计算机累死的

第 3 楼

得分:0

这是一个VBScript实现的大数除法，最可能出现的溢出问题是在判断被除数是否小于除数的地方。例如，如果两个参数值都是以String形式传入的，则可能出现以下问题：

字符串转化为数字时超出了数字类型能够表示的范围。
计算出错导致值错误。
我们可以通过尝试使用Decimal类型来解决这个问题。例如，修改函数的第一行：

Function BigNumDiv(x, y) Dim r, quotient, remainder, temp, temp1, temp2 Dim lenx, leny Dim i, j Dim dx, dy dx = CDec(x) ' 将 x 转为 Decimal 类型 dy = CDec(y) ' 将 y 转为 Decimal 类型 lenx = Len(x) leny = Len(y) If lenx < leny Then BigNumDiv = "0" Exit Function End If quotient = "" r = Mid(x, 1, leny) ...

这样可以将“x”和“y”转换为Decimal型，从而避免了可能产生的溢出问题。

会当凌绝顶,一览众山小.

第 4 楼

得分:0

在VBScript中，当进行大数除法时，可能会出现溢出问题，尤其是当Len(x) 的长度不足以容纳要计算的大数时，更容易出现此类问题。针对此问题，您可以采取以下方法修正：

使用整数类型进行除法运算。在除法运算中，整数类型的数值计算会更加精确，避免了溢出的可能性。例如，可以使用整数类型的数字和字符串，来避免大数类型在除法中的精度问题。
使用更高精度的数据类型。如果您需要处理非常大的数值，可以考虑使用更高精度的数据类型，例如长整型（Long）或者高精度数值类型（Double），来避免大数类型在除法中的精度问题。
使用高精度算法。如果您需要处理非常大的数值，并且溢出问题不可避免，可以考虑使用高精度算法，例如牛顿迭代法（Newton's method）或者高精度乘法（High Precision Multiplication），来避免大数类型在除法中的精度问题。
使用更高效的算法。如果您需要处理非常大的数值，并且溢出问题不可避免，可以考虑使用更高效的算法，例如快速幂算法（Fast Power Method）或者快速幂运算（Fast Power Arithmetic），来提高大数类型的除法速度。
编译选项。在编译VBScript时，可以通过设置编译选项来优化大数除法的计算速度。具体的设置方法可以参考VBScript的官方文档。
综上所述，以上方法可以帮助您修正在VBScript中进行大数除法时可能出现的溢出问题。

会当凌绝顶,一览众山小.

第 5 楼

得分:0

回复 4楼东海ECS

下面提供了完整的VBS代码，来修正一下吧。

' 大数加法
Function BigNumAdd(x, y)
Dim r, temp1, temp2
Dim i, c, sum
Dim j, k
Dim lenx, leny
lenx = Len(x)
leny = Len(y)
c = 0
r = ""
For i = lenx To 1 Step -1
j = CInt(Mid(x, i, 1))
If leny >= i Then k = CInt(Mid(y, i, 1)) Else k = 0
sum = j + k + c
If sum >= 10 Then
c = 1
sum = sum - 10
Else
c = 0
End If
temp1 = ChrW(48 + sum)
temp2 = r
r = temp1 & temp2
Next
If c > 0 Then r = "1" & r
BigNumAdd = r
End Function

' 大数减法，x > y
Function BigNumSub(x, y)
Dim r, temp1, temp2
Dim i, c, diff
Dim j, k
Dim lenx, leny
lenx = Len(x)
leny = Len(y)
c = 0
r = ""
For i = lenx To 1 Step -1
j = CInt(Mid(x, i, 1))
If leny >= i Then k = CInt(Mid(y, i, 1)) Else k = 0
diff = j - k - c
If diff < 0 Then
c = 1
diff = diff + 10
Else
c = 0
End If
temp1 = ChrW(48 + diff)
temp2 = r
r = temp1 & temp2
Next
While Len(r) > 1 And Left(r, 1) = "0"
r = Right(r, Len(r) - 1)
Wend
BigNumSub = r
End Function

' 大数乘法
Function BigNumMul(x, y)
Dim r, temp, temp1, temp2
Dim lenx, leny
Dim i, j, k, carry, sum
lenx = Len(x)
leny = Len(y)
temp = String(lenx + leny, "0")
For i = leny To 1 Step -1
j = CInt(Mid(y, i, 1))
carry = 0
For k = lenx To 1 Step -1
sum = j * CInt(Mid(x, k, 1)) + carry + CInt(Mid(temp, i + k, 1))
carry = sum \ 10
temp1 = ChrW(48 + (sum Mod 10))
temp2 = Mid(temp, 1, i + k - 1) & temp1 & Mid(temp, i + k + 1)
temp = temp2
Next
If carry > 0 Then
temp1 = ChrW(48 + carry)
temp2 = Mid(temp, 1, i + lenx) & temp1 & Mid(temp, i + lenx + 2)
temp = temp2
End If
Next
r = temp
While Len(r) > 1 And Left(r, 1) = "0"
r = Right(r, Len(r) - 1)
Wend
BigNumMul = r
End Function

' 大数除法，x > y
Function BigNumDiv(x, y)
Dim r, quotient, remainder, temp, temp1, temp2
Dim lenx, leny
Dim i, j
lenx = Len(x)
leny = Len(y)
If lenx < leny Then
BigNumDiv = "0"
Exit Function
End If
quotient = ""
r = Mid(x, 1, leny)
For i = leny + 1 To lenx
If r = "0" Then r = Mid(x, i, 1) Else r = r & Mid(x, i, 1)
quotient = quotient & "0"
j = 1
Do While BigNumSub(r, y) <> "" And CInt(BigNumSub(r, y)) >= 0
r = BigNumSub(r, y)
j = j + 1
Loop
quotient = Left(quotient, Len(quotient) - 1) & j - 1
Next
While Len(quotient) > 1 And Left(quotient, 1) = "0"
quotient = Right(quotient, Len(quotient) - 1)
Wend
If Len(quotient) = 0 Then quotient = "0"
While Len(r) > 1 And Left(r, 1) = "0"
r = Right(r, Len(r) - 1)
Wend
remainder = r
BigNumDiv = quotient
End Function

' 大数除法，x > y
Function BigNumDiv(x, y)
Dim r, quotient, remainder, temp, temp1, temp2
Dim lenx, leny
Dim i, j
lenx = Len(x)
leny = Len(y)
If lenx < leny Then
BigNumDiv = "0"
Exit Function
End If
quotient = ""
r = Mid(x, 1, leny)
For i = leny + 1 To lenx
If r = "0" Then r = Mid(x, i, 1) Else r = r & Mid(x, i, 1)
quotient = quotient & "0"
j = 1
Do While BigNumSub(r, y) <> "" And CLng(BigNumSub(r, y)) >= 0
r = BigNumSub(r, y)
j = j + 1
Loop
quotient = Left(quotient, Len(quotient) - 1) & j - 1
Next
While Len(quotient) > 1 And Left(quotient, 1) = "0"
quotient = Right(quotient, Len(quotient) - 1)
Wend
If Len(quotient) = 0 Then quotient = "0"
While Len(r) > 1 And Left(r, 1) = "0"
r = Right(r, Len(r) - 1)
Wend
remainder = r
BigNumDiv = quotient
End Function

MsgBox BigNumAdd("12345678901234567890", "98765432109876543210")  ' 显示 111111111111111111100
MsgBox BigNumSub("98765432109876543210", "12345678901234567890")  ' 显示 86419753208641975320
MsgBox BigNumMul("123456789012345678901234567890", "987654321098765432109876543210")  ' 显示 12193263113702179556720073558516635681494230864252625391052410
MsgBox BigNumDiv("98765432109876543210", "12345678901234567890")

心生万象，万象皆程序！
本人计算机知识网：http://bbs.为防伸手党，本站已停止会员注册。

第 6 楼

得分:20

下面给出大数的加减乘除函数，支持正负数：

程序代码：

Option Explicit

Function Rept0(n) ' n 个 0 的字符串
    Dim s, i
    s = ""
    For i=1 To n
        s = s & "0"
    Next
    Rept0 = s
End Function

Sub BigNumAdjLen(x, y) ' 调整大数字x、y（均正数）长度一致，短数左边+0
    Dim lenx, leny
    lenx = Len(x)
    leny = Len(y)
    If lenx>leny Then y = Rept0(lenx-leny) & y
    If lenx<leny Then x = Rept0(leny-lenx) & x
End Sub

Sub BigNumLTrim0(x) ' 删除大数左边多余的0（无负数）
    Dim i, lenx
    lenx = Len(x)
    For i=1 To lenx-1
        If mid(x,i,1)<>"0" Then Exit For
    Next
    If i>1 Then x = Mid(x, i, Len(x)-i+1)
End Sub

Sub BigNumFlag(x, flagx, absx) ' 获取长数字的正负号和绝对值
    If Left(x,1)="-" Then
        flagx = "-"
        absx = Right(x,Len(x)-1)
    Else
        flagx = "+"
        absx = x
    End If
End Sub

Function BigNumCmp(x, y) '大数比较，x>0、x=y、x<y 分别返回 1、0、-1
    Dim flagx, flagy, absx, absy, z
    If x=y Then
        z = 0
    Else
        BigNumFlag Trim(x), flagx, absx
        BigNumFlag Trim(y), flagy, absy
        BigNumAdjLen absx, absy
        Select Case flagx & flagy
            Case "++": If absx>absy Then z=1 Else z=-1
            Case "--": If absx>absy Then z=-1 Else z=1
            Case "+-": z = 1
            Case "-+": z = -1
        End Select
    End If
    BigNumCmp = z
End Function

Function BigNumAdd(x, y) '加法，判断正负数后调用纯加或者减
    Dim flagx, flagy, absx, absy, z
    BigNumFlag Trim(x), flagx, absx
    BigNumFlag Trim(y), flagy, absy
    Select Case flagx & flagy
        Case "++": z = BigNumAdd2(absx, absy)
        Case "--": z = "-" & BigNumAdd2(absx, absy)
        Case "+-": z = BigNumSub(absx, absy)
        Case "-+": z = BigNumSub(absy, absx)
    End Select
    BigNumAdd = z
    'WScript.Echo "DEBUG BigNumAdd(" & x & "," & y & ") = " & z
End Function

Function BigNumAdd2(x, y) '纯加（无负数）
    Dim z, i, t, zi
    BigNumAdjLen x, y
    z = ""
    t = 0 ' 进位
    For i = Len(x) To 1 Step -1
        zi = Asc(mid(x, i, 1)) + Asc(mid(y, i, 1)) - 96 + t
        If zi>=10 Then
            t = 1
            zi = zi - 10
        Else
            t = 0
        End If
        z = zi & z
    Next
    If t>0 Then z = t & z
    BigNumAdd2 = z
    'WScript.Echo "DEBUG BigNumAdd2(" & x & "," & y & ") = " & z
End Function

Function BigNumSub(x, y) '减法，判断正负数后调用纯加或者纯减
    Dim flagx, flagy, absx, absy, absxlen, absylen, z
    BigNumFlag Trim(x), flagx, absx
    BigNumFlag Trim(y), flagy, absy
    Select Case flagx & flagy
        Case "++": If BigNumCmp(absx,absy)>=0 Then z = BigNumSub2(absx, absy) Else z = "-" & BigNumSub2(absy, absx)
        Case "--": If BigNumCmp(absx,absy)>0 Then z = "-" & BigNumSub2(absx, absy) Else z = BigNumSub2(absy, absx)
        Case "+-": z = BigNumAdd2(absx, absy)
        Case "-+": z = "-" & BigNumAdd2(absx, absy)
    End Select
    BigNumSub = z
    'WScript.Echo "DEBUG BigNumSub(" & x & "," & y & ") = " & z
End Function

Function BigNumSub2(x, y) '纯减（无负数，x>=y）
    Dim z, i, t, zi
    BigNumAdjLen x, y
    z = ""
    t = 0 ' 借位
    For i = Len(x) To 1 Step -1
        zi = (Asc(mid(x, i, 1)) - 48) - (Asc(mid(y, i, 1)) - 48) - t
        If zi>=0 Then
            t = 0
            z = zi & z
        Else
            t = 1
            z = (zi + 10) & z
        End If
    Next
    BigNumLTrim0 z
    BigNumSub2 = z
    'WScript.Echo "DEBUG BigNumSub2(" & x & "," & y & ") = " & z
End Function

Function BigNumMul(x, y) '乘法，判断正负数后调用纯乘
    Dim flagx, flagy, absx, absy, absxlen, absylen, z
    BigNumFlag Trim(x), flagx, absx
    BigNumFlag Trim(y), flagy, absy
    Select Case flagx & flagy
        Case "++","--": z = BigNumMul2(absx, absy)
        Case "+-","-+": z = "-" & BigNumMul2(absx, absy)
    End Select
    BigNumMul = z
    'WScript.Echo "DEBUG BigNumMul(" & x & "," & y & ") = " & z
End Function

Function BigNumMul2(x, y) '纯乘法（无负数）
    Dim z, i, yi
    z = "0"
    If x<>"0" And y<>"0" Then
        For i=1 To Len(y)
            yi = (Asc(mid(y, i, 1)) - 48)
            z = BigNumAdd2(BigNumMul3(z, 10), BigNumMul3(x, yi))
        Next
    End If
    BigNumMul2 = z
    'WScript.Echo "DEBUG BigNumMul2(" & x & "," & y & ") = " & z
End Function

Function BigNumMul3(x, n) '纯乘法（无负数）2, 乘数n为一位数（0-10）
    Dim z, i, t, zi, m
    Select Case n
        Case 0:     z = "0"
        Case 10: z = x & "0"
        Case Else:
            z = ""
            t = 0 ' 进位
            For i=Len(x) To 1 Step -1
                zi = (Asc(mid(x, i, 1)) - 48) * n + t
                m = zi Mod 10
                t = (zi - m) / 10
                z = m & z
            Next
            If t>0 Then z = t & z
    End Select
    BigNumMul3 = z
    'WScript.Echo "DEBUG BigNumMul3(" & x & "," & n & ") = " & z
End Function

Function BigNumDiv(x, y) '除法，判断正负数后调用纯除
    Dim flagx, flagy, absx, absy, absxlen, absylen, z
    BigNumFlag Trim(x), flagx, absx
    BigNumFlag Trim(y), flagy, absy
    Select Case flagx & flagy
        Case "++","--": z = BigNumDiv2(absx, absy)
        Case "+-","-+": z = "-" & BigNumDiv2(absx, absy)
    End Select
    BigNumDiv = z
    WScript.Echo "DEBUG BigNumDiv(" & x & "," & y & ") = " & z
End Function

Function BigNumDiv2(x, y) '纯除（无负数）
    Dim i, z, xi, zi, m
    'WScript.Echo "DEBUG BigNumDiv2(" & x & "," & y & ") Start"
    xi = "0"    '第i次被除数
    m = "0"        '上次整除的余数
    z = ""
    For i=1 To Len(x)
        xi = BigNumAdd(BigNumMul(m, 10), mid(x,i,1))
        'WScript.Echo "DEBUG BigNumDiv2(" & x & "," & y & ") i=" & i & ", xi=" & xi
        BigNumDiv3 xi, y, zi, m
        z = z & zi
    Next
    BigNumLTrim0 z
    BigNumDiv2 = z
    'WScript.Echo "DEBUG BigNumDiv2(" & x & "," & y & ") = " & z
End Function

Sub BigNumDiv3(x, y, z, m) '纯除（无负数，商为一位数），x 整除 y，商 z、余 m
    Dim i, yi
    If y="1" Then
        z = x
        m = "0"
    ElseIf x="0" Then
        z = "0"
        m = "0"
    ElseIf x=y Then
        z = "1"
        m = "0"
    ElseIf BigNumCmp(x, y)<0 Then 'x<y
        z = "0"
        m = x
    Else'x>y
        z = 1
        m = BigNumSub(x, y)
        While BigNumCmp(m, y)>=0
            z = z + 1
            m = BigNumSub(m, y)
        WEnd
    End If
    'WScript.Echo "DEBUG BigNumDiv3(" & x & "," & y & ") = " & z & " ... " & m
End Sub

WScript.Echo "DEBUG:" & BigNumDiv("123", "1")
WScript.Echo "DEBUG:" & BigNumDiv("123456789", "1")
WScript.Echo "DEBUG:" & BigNumDiv("1234567890", "10")
WScript.Echo "DEBUG:" & BigNumDiv("15185185047", "123456789")
WScript.Echo "DEBUG:" & BigNumDiv("15185185047", "123")
WScript.Echo "DEBUG:" & BigNumDiv("56088", "456")

MsgBox BigNumDiv("12193263113702179556720073558516635681494230864252625391052410", "987654321098765432109876543210")
'原帖给的答案 123456789012345678901234567890 是错误的，正确结果是 12345678901234567924651296698834

下图是测试数据的运行情况，原帖子给出的示例用PHP8.2.3进行了交叉验证

图片附件: 游客没有浏览图片的权限，请登录或注册

确实老了，等我调试通过的时候，已经有高手发了完整代码，长江后浪推前浪，好。

收到的鲜花

yuma 于 2023-04-25 18:01 送鲜花 3朵附言：666