大数除法之估商法源码

Public Function myEXCEPT(str1 As StrToZx, str2 As StrToZx) As StrToZx        '除法子程序
        Dim a() As Long
        Dim b() As Long
        Dim i As Long
        Dim ysjg() As Long                                            '存放商
        Dim ysjg4to1() As Long                                        '把万进制商转换为十进制商时，存放在这儿。
        Dim Bjs() As Long                                             '存放减数，后面的核心运算有大数减法
        Dim yShu() As Long                                            '存放运行中的余数
        Dim jg As StrToZx                                             '存放最后结果
        Dim string1 As StrToZx
        Dim string2 As StrToZx

        string1 = str1
        string2 = str2
        Dim cszd As Integer
        cszd = 1
        string1 = Zjzzh(string1, cszd)                                                 ' 转换成10进制数
        string2 = Zjzzh(string2, cszd)
        string1 = jdkz(string1, jd + 4)                                                精度控制,减少不必要的运算
        string2 = jdkz(string2, jd + 4)
        string2jw1 = string2.XsdWz - 1                                                  '解决除数0.000...01的问题  如不调整0.001也可以运行
        string2.XsdWz = 1
        
        string1 = qslqwl(string1)                                                    '除去数首和数尾部的零
        string2 = qslqwl(string2)
        For i = 1 To string2.strlen                                                  '除数为零提示返回
                If string2.Zx(i) <> 0 Then
                    Exit For
                ElseIf i = string2.strlen Then
                    MsgBox "除法子程序中除数为零", vbExclamation, "错误提示"
                    Exit Function
                End If
        Next

        cszd = 4
        string1 = Zjzzh(string1, cszd)                            '转换为万进制        
        string1 = qslqwl(string1)                                  '除去数首和数尾部的零
         
        Dim tempQszl As Long                             '获取除数最佳倍乘数(qszl ), 下面一大段是关键步骤 ,运行时间可忽略不计
        Dim tempSz(-1 To 10) As Byte                     '清零
        For i = -1 To 10
            tempSz(i) = 0
        Next
        tempQszl1 = string2.strlen                       '后面几步是判断应该获取的除数长度，大于8，取8位，小于8，取实际长度
        If tempQszl1 > 8 Then
           tempQszl1 = 8
        End If
        For i = 1 To tempQszl1
            tempSz(i) = string2.Zx(i)
        Next
        tempQszl = 0
        For i = 0 To 7
            tempQszl = tempQszl + tempSz(8 - i) * 10 ^ i
        Next
        qszl = 0
        For i = 1 To 10
            temp = tempQszl * i
            If temp >= 100000000 Then
                qszl = i - 1                             ' 除数整理，qszl 参数乘以除数后，使除数的第一个十进制位接近10,例:1234中的1变为8
                Exit For
            End If
        Next


        str2len = string2.strlen - string2.XsdWz                               这一段就是把例:0012 3456转换成1234 5600,运行时间忽略不计, 下面一段是关键步骤
        LL = str2len Mod 4
        string2jw = 0
        If LL <> 0 Then
            string2jw = 4 - LL
            string2.strlen = string2.strlen + string2jw
            ReDim Preserve string2.Zx(-1 To string2.strlen + 2) As Long
        End If
                                                                    
         JzZh1to4 string2                                                               '十进制转换成万进制

        If qszl > 1 Then                                                                  '下面这段代码会占用一定的计算时间(单精对多精乘两次), 下面一段是是关键步骤
                jw4 = 0                                                                        '除数乘（除数整理调整参数qszl）
                For i = string2.strlen To 1 Step -1
                    string2.Zx(i) = string2.Zx(i) * qszl + jw4
                    jw4 = string2.Zx(i) \ 10000
                    string2.Zx(i) = string2.Zx(i) Mod 10000
                Next              
                jw5 = 0                                                                  '被除数乘（除数整理调整参数qszl）
                For i = string1.strlen To 0 Step -1
                    string1.Zx(i) = string1.Zx(i) * qszl + jw5
                    jw5 = string1.Zx(i) \ 10000
                    string1.Zx(i) = string1.Zx(i) Mod 10000
                Next
                If string1.Zx(0) <> 0 Then                                               '如果产生了进位，把被除数整体后移一位
                    For i = string1.strlen To 1 Step -1
                        string1.Zx(i) = string1.Zx(i - 1)
                    Next
                    string1.strlen = string1.strlen + 1
                    ReDim Preserve string1.Zx(-1 To string1.strlen + 2) As Long
                End If
                string1.Zx(0) = 0               
        End If


        string2 = qslqwl(string2)
        GzBzsLen = jd \ 4 + string2.strlen + 4                 '扩展被除数长度
        a() = string1.Zx()
        b() = string2.Zx()
        tempstr2 = string2.strlen + 2
        ReDim Preserve a(-1 To GzBzsLen + 2) As Long             '存放扩展后的被除数
        ReDim Preserve b(-1 To tempstr2) As Long                 '存放除数
        ReDim ysjg(-1 To GzBzsLen + 2) As Long                   '存放商
        ReDim ysjg4to1(-1 To GzBzsLen * 4 + 2) As Long           '存放十进制商
        ReDim Bjs(-1 To tempstr2)                                '存放所估出的商和除数的积
        ReDim yShu(-1 To tempstr2)                               '存放余数，它初始化为被除数
        For i = string1.strlen To 1 Step -1                 '扩展后的被除数左前方预留一位零 ,                   是关键步骤
            a(i + 1) = a(i)
        Next
        a(1) = 0
        string1.strlen = string1.strlen + 1                  '除数左前方预留一位零 ,                 是关键步骤
        For i = string2.strlen To 1 Step -1
            b(i + 1) = b(i)
        Next
        b(1) = 0
        string2.strlen = string2.strlen + 1


        azd = string2.strlen                                 '被除数是取出和除数等长的数到余数数组参加运算，这时这个标志的所标位置，即是被除数待取数位置标志。也作为退出运算标志。 是关键步骤
        For i = 1 To string2.strlen                          '从被除数中取出和除数等长的数，被除数和除数左方必须加一个零例：987/12 转换成 0987/012     
            yShu(i) = a(i)
        Next

        i = 1                                                                  下面是核心运算代码
        Do
line2:
            If yShu(2) > b(2) Then                '当余数大于除数时的处理，yShu() 数组中存放第一次运算后的余数，b()数组中存放除数
                ysjg(i) = (yShu(2) * 10 + yShu(3) \ 1000) \ (b(2) * 10 + b(3) \ 1000)        '估商             是关键步骤
line1:
                jw1 = 0
                For j = string2.strlen To 1 Step -1                        '单精对多精乘， Bjs()数组中存入所估商和除数的积
                    Bjs(j) = ysjg(i) * b(j) + jw1
                    jw1 = Bjs(j) \ 10000
                    Bjs(j) = Bjs(j) Mod 10000
                Next
                Bjs(2) = Bjs(1) * 10000 + Bjs(2)              'Bjs(2)中存放的是Bjs(1)和Bjs(2)合并后的数，方便后面的比较和判断。
                Bjs(1) = 0
                
                jw2 = 0                                                    '多精对多精减，
                For u = string2.strlen To 1 Step -1
                    yShu(u) = yShu(u) - Bjs(u) - jw2
                    If yShu(u) < 0 Then
                        yShu(u) = yShu(u) + 10000
                        jw2 = 1
                    Else
                        jw2 = 0
                    End If
                Next
                
           '假如发生了借位，代表这次的估商是错误的，此时商减一，余数加一次除数，估出的商只会大于或等于正确商,当商不正确时，做减法时会从 yShu(1)借位， yShu(1)从零变为9999，修正后 yShu(1)变回零,    是关键步骤,重点
                jw3 = 0         
                Do While yShu(1) = 9999
                    For u = string2.strlen To 1 Step -1
                        yShu(u) = yShu(u) + b(u) + jw3
                        If yShu(u) >= 10000 Then
                           jw3 = 1
                           yShu(u) = yShu(u) - 10000
                        Else
                           jw3 = 0
                        End If
                    Next
                    ysjg(i) = ysjg(i) - 1                               '商减一 
                Loop
                yShu(1) = 0
            End If

            If yShu(2) < b(2) Then                                 '当余数小于除数时的处理
line3:
                yShu(2) = yShu(2) * 10000 + yShu(3)
                For v = 3 To string2.strlen - 1
                    yShu(v) = yShu(v + 1)
                Next
                If azd = GzBzsLen Then                             '这里控制运算长度，从这里退出循环
                    Exit Do
                End If
                azd = azd + 1
                yShu(string2.strlen) = a(azd)
                i = i + 1
                GoTo line2
            End If

            If yShu(2) = b(2) Then                                 '当余数和除数相等时的处理
                For w = 3 To string2.strlen
                    If yShu(w) < b(w) Then
                        GoTo line3
                    End If
                    If yShu(w) > b(w) Then
                        ysjg(i) = 1
                        GoTo line1
                    End If
                    If w = string2.strlen Then
                        ysjg(i) = 1
                        GoTo line1
                    End If
                Next
            End If
        Loop
        
        bz = 0                                                    '转换成十进制，因为小数点的对位要在十进制下进行
        j = (jd \ 4) * 4 + 16
        For i = (jd \ 4 + 4) To 1 Step -1                                                           '
            ysjg4to1(j) = ysjg(i)
            Do
                ysjg4to1(j - 1) = ysjg4to1(j) \ 10
                ysjg4to1(j) = ysjg4to1(j) Mod 10
                j = j - 1
                bz = bz + 1
            Loop While bz <> 4
            bz = 0
        Next

         GzBzsLen4 = GzBzsLen * 4                                                     '下面几句代码主要是确定小数点位置，数字长度，正负,指数
         string1.strlen = string1.strlen * 4 - string1.XsdWz + string2.XsdWz
         jg.JzBz = 1
         jg.strlen = GzBzsLen4
         jg.XsdWz = GzBzsLen4 - string1.strlen + string2.strlen * 4 - string2jw - 4 - string2jw1
         jg.Zx() = ysjg4to1()
         temp1 = jg.XsdWz - jg.strlen + 1
         jg.eE = jg.eE - temp1                                      
         jg.eE = jg.eE + string1.eE - string2.eE                          '计算最终结果的指数
         jg.XsdWz = jg.strlen - 1
         If string1.ZhFhBz <> string2.ZhFhBz Then                    '根据两运算数的正负符号确定最终得数的正负符号
            jg.ZhFhBz = False
         Else
            jg.ZhFhBz = True
         End If
       
        cszd = 1
        jg = Zjzzh(jg, cszd)                                           转换成十进制数
        jg = jdkz(jg, (jd + 4))                                        '精度控制
        jg = qslqwl(jg)                                                '除去数的首零和尾零
        myEXCEPT = jg
    End Function


上面的程序并没在代码易读性上优化,某些方面可能重复,也可能误删了代码,(源代码中插有一些调用迭代除法的代码,测试代码,为了不影响阅读,作了删除操作)不明白的再问我.
程序支持整数,小数,采用科学记数法的数的运算,并通过测试,并非凭空猜测.