下面传一下这个完整的程序代码，代码如下：
Private Sub Command1_Click() '快速除法程序
Dim A, B
A = Trim(Text1): B = Trim(Text2): b3 = B: a3 = A
ts = Timer
If Len(B) = 1 Then
X1 = Mid(B, 1, 1): X2 = 1 / X1 - 0.01
Else
X1 = Mid(B, 1, 2): X2 = 10 / X1 - 0.01
End If
x = Mid(X2, 1, 4)
Y = 0: x3 = 0
sb = Len(a3) + Len(b3) - 1 + 10
If Len(a3) = Len(b3) And MBJC(Trim(a3), Trim(b3)) = 0 Then
a1 = 1
Text3 = a1
Else
If MBJC(Mid(a3, 1, Len(b3)), Trim(b3)) = 0 And Val(Len(qdhz0(Trim(a3)))) = Val(Len(b3)) Then
a1 = 1 & String(Len(a3) - Len(qdhz0(Trim(a3))), "0")
Else
A = A & String(10, "0"): B = B & String(10 + Len(a3), "0")
x = qdqd0(ydxsd(Trim(x), Val(sb)))
Y1 = 2 & String(Val(sb), "0")
Do While MBJC(MPC(Trim(x), Trim(x3)), 1) >= 0
s3 = s3 + 1
Y = mbc2(Trim(x), MPC(Trim(Y1), mbc2(Trim(B), Trim(x), Val(sb))), Val(sb))
x3 = x
x = Trim(Y)
Loop
a1 = mbc2(Trim(Y), Trim(A), Val(sb))
s = Len(a3) - Len(b3)
a1 = qdqd0(Trim(a1))
If MBJC(Mid(a3, 1, Len(b3)), Trim(b3)) < 0 Then
a1 = tjxsd(Trim(a1), Len(a1) - s)
Else
a1 = tjxsd(Trim(a1), Len(a1) - s - 1)
End If
End If
If InStr(a1, ".") = 0 Then
a1 = a1
Else
a1 = Left(a1, InStr(a1, ".") - 1)
End If
ja = MPC(Trim(a3), MbC4(Trim(b3), Trim(a1)))
Do While MBJC(Trim(ja), Trim(b3)) >= 0
ja = MPC(Trim(ja), Trim(b3))
s5 = s5 + 1
Loop
a1 = MPC1(Trim(a1), Trim(s5))
If ja = 0 Then
Text3 = a1 & "有" & Len(a1) & "位，用时" & Timer - ts & "秒"
Else
Text3 = a1 & "/" & ja & "有" & Len(a1) & "位，用时" & Timer - ts & "秒"
End If
End If
End Sub
Private Sub Command2_Click()
Text1 = ""
Text2 = ""
Text3 = ""
End Sub
Public Function MbC4(D1 As String, D2 As String) As String '快速乘法
Dim l As Long, le As Long, le1 As Long, n As Long, r As Long, p As Long, q As Long, m As Byte
Dim wr As Double, w1 As Double, wlr As Double, wl1 As Double, tr As Double, t1 As Double
Dim pi As Double, t As Double, tr1 As Double
If Len(D1) + Len(D2) < 30000 Then
MbC4 = MbC(Trim(D1), Trim(D2))
Else
Dim xr() As Double, A As String
A = Trim(D1)
B = Trim(D2)
x = Len(A) \ 4: Y = Len(B) \ 4
A = String(Val(x * 4 + 4 - Len(A)), "0") & A
B = String(Val(Y * 4 + 4 - Len(B)), "0") & B
x = x + 1: Y = Y + 1
sb1 = x + Y
sb2 = Log(sb1) / Log(2)
If InStr(sb2, ".") = 0 Then
sb2 = sb2
Else
sb2 = Int(sb2) + 1
End If
sb = 2 ^ sb2
A = String(Val(sb) * 4 - Len(A), "0") & A
B = String(Val(sb) * 4 - Len(B), "0") & B
ReDim x_(1 To sb): ReDim y_(1 To sb)
For i1 = 1 To sb
x_(i1) = Mid(A, (sb - i1 + 1) * 4 - 3, 4): y_(i1) = Mid(B, (sb - i1 + 1) * 4 - 3, 4)
If Len(x_(i1)) < 4 Then
x_(i1) = String(4 - Len(x_(i1)), "0") & x_(i1)
ElseIf Len(y_(i1)) < 4 Then
y_(i1) = String(4 - Len(y_(i1)), "0") & y_(i1)
Else
x_(i1) = x_(i1): y_(i1) = y_(i1)
End If
Next
ReDim xr(0 To (Len(A) - 4) \ 4): ReDim yr(0 To (Len(B) - 4) \ 4): ReDim zr(0 To (Len(B) - 4) \ 4)
If Len(A) = 4 Then
xr(0) = A: yr(0) = B
Else
Dim I As Long, J As Long, mn As Long, lh As Long, k As Long
'位序倒置
n = sb '求数组大小，其值必须是2的幂
lh = n / 2
J = n / 2
For I = 1 To n - 2
Debug.Print I, J
k = lh '下面是向右进位算法
Do
If k > J Then Exit Do '高位是1吗
J = J - k '是的，高位置0
k = k / 2 '准备次高位的权
Loop Until k = 0 '次高位的权若非0，则检查新的次高位
J = J + k '非则若最高位是0，则置1
xr(I + 1) = x_(J + 1): yr(I + 1) = y_(J + 1)
Next
xr(0) = x_(1): xr(1) = x_(1 + sb / 2)
yr(0) = y_(1): yr(1) = y_(1 + sb / 2)
End If
Dim xi(): Dim yi(): Dim zi()
n = sb '求数组大小，其值必须是2的幂
m = 0
l = 2
pi = 3.14159265358979
Do
l = l + l
m = m + 1
Loop Until l > n
n = l / 2
ReDim xi(n - 1): ReDim yi(n - 1): ReDim zi(n - 1)
l = 1
Do
le = 2 ^ l
le1 = le / 2
wr = 1
wi = 0
If l = 1 Then
t = 0
Else
t = pi / le1
End If
w1r = Cos(t)
w1i = -Sin(t)
r = 0
Do
p = r
Do
q = p + le1
tr = xr(q) * wr - xi(q) * wi
ti = xr(q) * wi + xi(q) * wr
tr1 = yr(q) * wr - yi(q) * wi
ti1 = yr(q) * wi + yi(q) * wr
xr(q) = xr(p) - tr
xi(q) = xi(p) - ti
xr(p) = xr(p) + tr
xi(p) = xi(p) + ti
yr(q) = yr(p) - tr1
yi(q) = yi(p) - ti1
yr(p) = yr(p) + tr1
yi(p) = yi(p) + ti1
xr(p) = Format(Val(xr(p)), "0.000000"): xi(p) = Format(Val(xi(p)), "0.000000")
yr(p) = Format(Val(yr(p)), "0.000000"): yi(p) = Format(Val(yi(p)), "0.000000")
p = p + le
Loop Until p > n - 1
wr2 = wr * w1r - wi * w1i
wi2 = wr * w1i + wi * w1r
wr = wr2
wi = wi2
r = r + 1
Loop Until r > le1 - 1
l = l + 1
Loop Until l > m
For I = 0 To n - 1 '仅输出模
zr(I) = xr(I) * yr(I) - xi(I) * yi(I): zi(I) = xr(I) * yi(I) + xi(I) * yr(I)
zr(I) = Format(Val(zr(I)), "0.000000"): zi(I) = Format(Val(zi(I)), "0.000000")
's = s & "/" & zr(I)
's1 = s1 & "/" & zi(I)
Next
J = sb
ReDim x_(1 To sb): ReDim y_(1 To sb)
For k = 1 To J
n1 = n1 + 1
ReDim Preserve x_(1 To n1)
x_(n1) = zr(n1 - 1): y_(n1) = zi(n1 - 1)
x_(n1) = Format(Val(x_(n1)), "0.000000"): y_(n1) = Format(Val(y_(n1)), "0.000000")
Next
'位序倒置
n = sb '求数组大小，其值必须是2的幂
lh = n / 2
J = n / 2
For I = 1 To n - 2
Debug.Print I, J
k = lh '下面是向右进位算法
Do
If k > J Then Exit Do '高位是1吗
J = J - k '是的，高位置0
k = k / 2 '准备次高位的权
Loop Until k = 0 '次高位的权若非0，则检查新的次高位
J = J + k '非则若最高位是0，则置1
xr(I + 1) = x_(J + 1): yr(I + 1) = y_(J + 1)
'js = js & "/" & x_(J + 1)
'js1 = js1 & "/" & y_(J + 1)
Next
'sx1 = "/" & x_(1) & "/" & x_(1 + sb / 2) & js
'sy1 = "/" & y_(1) & "/" & y_(1 + sb / 2) & js1
xr(0) = x_(1): xr(1) = x_(1 + sb / 2)
yr(0) = y_(1): yr(1) = y_(1 + sb / 2)
ns = Len(A) \ 4: Jn = ns
ReDim zr(0 To ns - 1)
m = 0
l = 2
pi = 3.14159265358979
Do
l = l + l
m = m + 1
Loop Until l > ns
ns = l / 2
ReDim xi(ns - 1): ReDim yi(ns - 1): ReDim zi(ns - 1)
l = 1
Do
le = 2 ^ l
le1 = le / 2
wr = 1
wi = 0
If l = 1 Then
t = 0
Else
t = -1 * pi / le1
End If
w1r = Cos(t)
w1i = -Sin(t)
r = 0
Do
p = r
Do
q = p + le1
tr = xr(q) * wr - xi(q) * wi
ti = xr(q) * wi + xi(q) * wr
tr1 = yr(q) * wr - yi(q) * wi
ti1 = yr(q) * wi + yi(q) * wr
xr(q) = xr(p) - tr
xi(q) = xi(p) - ti
xr(p) = xr(p) + tr
xi(p) = xi(p) + ti
yr(q) = yr(p) - tr1
yi(q) = yi(p) - ti1
yr(p) = yr(p) + tr1
yi(p) = yi(p) + ti1
xr(p) = Format(Val(xr(p)), "0.000000"): xi(p) = Format(Val(xi(p)), "0.000000")
yr(p) = Format(Val(yr(p)), "0.000000"): yi(p) = Format(Val(yi(p)), "0.000000")
p = p + le
Loop Until p > ns - 1
wr2 = wr * w1r - wi * w1i
wi2 = wr * w1i + wi * w1r
wr = wr2
wi = wi2
r = r + 1
Loop Until r > le1 - 1
l = l + 1
Loop Until l > m
For I = 0 To ns - 1 '仅输出模
zr(I) = (xr(I) - yi(I)) / n
zr(I) = Format(Val(zr(I) + 0.5), "0.000000")
If InStr(zr(I), ".") = 0 Then
s121 = zr(I)
Else
s121 = Left(zr(I), InStr(zr(I), ".") - 1)
End If
's0 = "/" & s121 & s0
zr(I) = s121
Next
For i1 = 1 To Val(Jn - sb1 + 1)
zr(sb1 + i1 - 2) = 0
Next
For i1 = 0 To n - 1
If zr(i1) < 0 Then
zr(i1) = "0000"
ElseIf Len(zr(i1)) < 4 Then
zr(i1) = String(4 - Len(zr(i1)), "0") & zr(i1)
Else
zr(i1) = zr(i1)
End If
's5 = s5 & "/" & zr(i1)
If i1 = 0 Then
s6 = Val(Left(zr(i1), Len(zr(i1)) - 4))
If Len(s6) < 4 Then
s6 = String(4 - Len(s6), "0") & s6
Else
s6 = s6
End If
s8 = Right(zr(i1), 4)
ElseIf Val(zr(i1)) >= 0 Then
s7 = Val(zr(i1)) + Val(s6)
If Len(s7) = 4 Or Len(s7) = 8 Or Len(s7) = 12 Then
s7 = s7
Else
s7 = String(12 - Len(s7), "0") & s7
End If
s10 = Right(s7, 4)
s11 = s10 & s11
If Len(s7) < 4 Then
s7 = String(4 - Len(s7), "0") & s7
ElseIf Len(s7) = 4 Then
s6 = "0000"
Else
s7 = s7
s6 = Val(Left(s7, Len(s7) - 4))
End If
Else
s6 = s6
End If
Next
s9 = s6 & s11 & s8
s9 = qdqd0(Trim(s9))
's2 = nifft(dxcx1(Trim(s)), dxcx1(Trim(s1)), Trim(sb1))
's3 = nifft(Trim(sx1), Trim(sy1), Trim(sb1))
MbC4 = s9
End If
End Function
Private Function mbc2(sa As String, sb As String, sd As String) As String 'chengfa jingdu
Dim ja
If Trim(sa) = 0 Or Trim(sb) = 0 Then
mbc2 = 0
Else
ja = MbC4(Trim(sa), Trim(sb))
If Val(Len(ja)) > Val(sd) Then
jb = Left(ja, Val(Len(ja)) - Val(sd))
mbc2 = jb
Else
mbc2 = 0
End If
End If
End Function
Private Function qdhz0(sa As String) As String
A = sa
Do While Right(A, 1) = "0"
A = Left(A, Len(A) - 1)
Loop
If A = "" Then
A = 0
Else
A = A
End If
qdhz0 = A
End Function
Private Function qdqd0(sa As String) As String
A = sa
Do While Left(A, 1) = "0"
A = Mid(A, 2)
Loop
If A = "" Then
A = 0
Else
A = A
End If
qdqd0 = A
End Function
Private Function tjxsd(sa As String, sd As String) As String
If Val(Len(sa)) > Val(sd) Then
tjxsd = Left(sa, Val(Len(sa)) - Val(sd)) & "." & Mid(sa, Val(Len(sa)) - Val(sd) + 1)
Else
If Val(Len(sa)) = Val(sd) Then
tjxsd = "0." & sa
Else
tjxsd = "0." & String(Val(sd) - Val(Len(sa)), "0") & Trim(sa)
End If
End If
End Function
Private Function ydxsd(sa As String, sd As String) As String
If Len(sa) = 1 And Val(sa) = 0 Then
ydxsd = 0
Else
sc = InStr(sa, ".")
If Val(sc) = 0 Then
ydxsd = sa & String(sd, "0")
Else
se = Left(sa, Val(sc) - 1)
sf = Right(sa, Len(sa) - Val(sc))
If Val(Len(sf)) >= Val(sd) Then
ydxsd = se & Mid(sf, 1, sd)
Else
ydxsd = se & sf & String(Val(sd) - Len(sf), "0")
End If
End If
End If
End Function
Public Function MbC(D1 As String, D2 As String) As String
Dim j1&, j2&, e&, d&, E1&
' 按列法计算C=A*B
m = Trim(D1): n = Trim(D2)
x = Len(m) \ 4: Y = Len(n) \ 4
m = String(4 * x + 4 - Len(m), "0") & m
n = String(4 * Y + 4 - Len(n), "0") & n
x = x + 1: Y = Y + 1
Dim A(), B()
ReDim A(1 To x): ReDim B(1 To Y)
For i1 = 1 To x
A(i1) = Val(Mid(m, i1 * 4 - 3, 4))
Next
For i2 = 1 To Y
B(i2) = Val(Mid(n, i2 * 4 - 3, 4))
Next
ma = x: mb = Y
MC = ma + mb
ReDim c(MC)
E1 = 0
j1 = ma: j2 = ma
For I = MC To 2 Step -1
If I <= ma Then j2 = I - 1
e = E1: E1 = 0
For J = j1 To j2
e = e + A(J) * B(I - J)
If e > 2040000000 Then '减少进位次数
e = e - 2040000000
E1 = E1 + 204000
End If
Next J
If j1 > 1 Then j1 = j1 - 1
base = 10000
d = e \ base
c(I) = e - d * base
If Len(c(I)) < 4 Then
c(I) = String(4 - Len(c(I)), "0") & c(I)
Else
c(I) = c(I)
End If
jc = c(I) & jc
E1 = E1 + d
Next I
jc = d & jc
MbC = qqdl(Trim(jc))
End Function
Public Function MPC(D1 As String, D2 As String) As String ';jianfaqi
Dim x, Y ';两数长度
If Len(D1) >= Len(D2) Then
D4 = String(Len(D1) - Len(D2), "0") & D2
D3 = D1
Else
D4 = D2
D3 = String(Len(D2) - Len(D1), "0") & D1
End If
x = Len(D3) \ 8: Y = Len(D4) \ 8
If Len(D3) > 8 * x Then
D3 = String(8 * x + 8 - Len(D3), "0") & D3
D4 = String(8 * Y + 8 - Len(D4), "0") & D4
x = x + 1: Y = Y + 1
Else
x = x: Y = Y
D3 = D3: D4 = D4
End If
Dim A() As String, B1() As String, C1() As String, E1() As String
ReDim A(1 To x)
ReDim B1(1 To Y)
ReDim C1(1 To x)
ReDim E1(1 To x)
Dim I, J, C2, CJ, JW
For J = Y To 1 Step -1 ';D2
JW = 1 ';yu jie weichuzhi
B1(J) = Mid(D4, J * 8 - 7, 8) ';每位数
For I = x To 1 Step -1 ';D1
A(I) = Mid(D3, I * 8 - 7, 8) ';每位数
C1(I) = Val(1 & A(I)) - Val(B1(I)) - Val(1) + Val(JW) ';计算jia
JW = C1(I) \ 10 ^ 8
E1(I) = C1(I) Mod 10 ^ 8
If Len(E1(I)) < 8 Then
E1(I) = String(8 - Len(E1(I)), "0") & E1(I)
Else
E1(I) = E1(I)
End If
Next
Next
For r = 1 To x
MPC = MPC & E1(r)
If Len(MPC) > Len(D1) Then
MPC = Mid(MPC, Len(MPC) - Len(D1) + 1)
Else
MPC = MPC
End If
For I = 1 To Len(MPC)
If Not Mid(MPC, I, 1) = "0" Then
Exit For
End If
Next
strtmp = Mid(MPC, I)
If Len(strtmp) = 0 Then
MPC = "0"
Else
MPC = strtmp
End If
Next
End Function
Public Function MPC1(D1 As String, D2 As String) As String 'jiafa
Dim x, Y, JW '两数长度
If Len(D1) >= Len(D2) Then
D4 = String(Len(D1) - Len(D2), "0") & D2
D3 = D1
Else
D4 = D2
D3 = String(Len(D2) - Len(D1), "0") & D1
End If
x = Len(D3) \ 8: Y = Len(D4) \ 8
If 8 * x < Len(D3) Then
D3 = String(8 * x + 8 - Len(D3), "0") & D3
D4 = String(8 * Y + 8 - Len(D4), "0") & D4
x = x + 1: Y = Y + 1
Else
x = x: Y = Y
D3 = D3: D4 = D4
End If
Dim A() As String, B1() As String, C1() As String, E1() As String
ReDim A(1 To x)
ReDim B1(1 To Y)
ReDim C1(1 To x)
ReDim E1(1 To x)
Dim I, J, C2, CJ
For J = Y To 1 Step -1 'D2
JW = 0 '进位清0
B1(J) = Mid$(D4, J * 8 - 7, 8) '每位数
For I = x To 1 Step -1 'D1
A(I) = Mid$(D3, I * 8 - 7, 8) '每位数
C1(I) = Val(A(I)) + Val(B1(I)) + Val(JW) '计算jia
If Len(C1(I)) < 8 Then
C1(I) = String(8 - Len(C1(I)), "0") & C1(I)
Else
C1(I) = C1(I)
End If
JW = Left(C1(I), Len(C1(I)) - 8)
E1(I) = Right(C1(I), 8)
Next
Next
For r = 1 To x
If JW = 0 Then
MPC1 = MPC1 & E1(r)
Else
jc = jc & E1(r)
MPC1 = JW & jc
End If
Next
MPC1 = qqdl(Trim(MPC1))
End Function
Public Function MBJC(D1 As String, D2 As String) As String ';bijiao
If Len(D1) <= 10 And Len(D2) <= 10 Then
If Val(D1) > Val(D2) Then
MBJC = 1
Else
If Val(D1) = Val(D2) Then
MBJC = 0
Else
MBJC = -1
End If
End If
Else
If Len(D1) > Len(D2) Then
MBJC = 1
Else
If Len(D1) < Len(D2) Then
MBJC = -1
Else
If Len(D1) = Len(D2) Then
Dim x, Y
x = Len(D1) \ 4: Y = Len(D2) \ 4
Dim A() As String, B() As String
ReDim A(4 To 4 * x + 4)
ReDim B(4 To 4 * Y + 4)
If Val(Left(D1, Len(D1) - 4 * x)) > Val(Left(D2, Len(D2) - 4 * Y)) Then
MBJC = 1
Else
If Val(Left(D1, Len(D1) - 4 * x)) < Val(Left(D2, Len(D2) - 4 * Y)) Then
MBJC = -1
Else
For I = 4 To 4 * x Step 4
A(I) = Mid(D1, Len(D1) - I + 1, 4)
B(I) = Mid(D2, Len(D2) - I + 1, 4)
Next
J = 4 * x
Do While A(J) = B(J) And J >= 8
J = J - 4
Loop
If Val(A(J)) - Val(B(J)) > 0 Then
MBJC = 1
Else
If Val(A(J)) - Val(B(J)) < 0 Then
MBJC = -1
Else
MBJC = 0
End If
End If
End If
End If
End If
End If
End If
End If
End Function
'符号运算程序
Private Function fhys(sa As String) As String
If InStr(sa, "-") = 0 Then
fhys = 1
Else
fhys = -1
End If
End Function
'添加符号程序
Private Function tjfh(sa As String, sf As String) As String 'qianjia fuhao
If Val(sf) < 0 Then
tjfh = "-" & sa
Else
tjfh = sa
End If
End Function
'带符号的加法程序
Private Function mpc3(sa As String, sb As String) As String 'jiafa jingdu daifh
Dim ja
fh1 = fhys(sa)
fh2 = fhys(sb)
If Val(fh1) * Val(fh2) > 0 Then
ja = MPC1(qdfh(sa), qdfh(sb))
If Val(fh1) > 0 Then
mpc3 = ja
Else
mpc3 = "-" & ja
End If
Else
xd = MBJC(qdfh(sa), qdfh(sb))
If xd >= 0 Then
jb = qqdl(MPC(qdfh(sa), qdfh(sb)))
Else
jb = qqdl(MPC(qdfh(sb), qdfh(sa)))
End If
If xd >= 0 And Val(fh1) > 0 Then
mpc3 = jb
Else
If xd > 0 And Val(fh1) < 0 Then
mpc3 = "-" & jb
Else
If Val(fh2) < 0 Then
mpc3 = "-" & jb
Else
mpc3 = jb
End If
End If
End If
End If
End Function
'带符号的减法程序
Private Function mpc2(sa As String, sb As String) As String 'jianfa jingdu daifh
Dim ja
fh1 = fhys(sa)
fh2 = fhys(sb)
xd = MBJC(qqdl(qdfh(sa)), qqdl(qdfh(sb)))
If Val(fh1) * Val(fh2) < 0 Then
ja = MPC1(qdfh(sa), qdfh(sb))
If Val(fh1) > 0 Then
mpc2 = ja
Else
mpc2 = "-" & ja
End If
Else
If xd >= 0 Then
jb = qqdl(MPC(qdfh(sa), qdfh(sb)))
Else
jb = qqdl(MPC(qdfh(sb), qdfh(sa)))
End If
If xd >= 0 And Val(fh1) > 0 Then
mpc2 = jb
Else
If xd > 0 And Val(fh1) < 0 Then
mpc2 = "-" & jb
Else
If Val(fh2) <= 0 Then
mpc2 = jb
Else
mpc2 = "-" & jb
End If
End If
End If
End If
End Function
'去前导0的程序
Private Function qqdl(sa As String) As String
For I = 1 To Len(sa)
If Not Mid(sa, I, 1) = "0" Then
Exit For
End If
Next
strtmp = Mid(sa, I)
If Len(strtmp) = 0 Then
qqdl = "0"
Else
qqdl = strtmp
End If
End Function
'带符号的比较大小程序
Private Function mbjc2(sa As String, sb As String) As String 'bi jiao dx daifh
Dim ja
fh1 = fhys(sa)
fh2 = fhys(sb)
If Val(fh1) < Val(fh2) Then
mbjc2 = -1
Else
If Val(fh1) > Val(fh2) Then
mbjc2 = 1
Else
ja = MBJC(qdfh(sa), qdfh(sb))
If Val(fh1) > 0 And Val(ja) > 0 Then
mbjc2 = 1
Else
If Val(fh1) < 0 And Val(ja) > 0 Then
mbjc2 = -1
Else
If Val(fh1) > 0 And Val(ja) < 0 Then
mbjc2 = -1
Else
If Val(fh1) < 0 And Val(ja) < 0 Then
mbjc2 = 1
Else
mbjc2 = 0
End If
End If
End If
End If
End If
End If
End Function
'带符号的乘法程序
Private Function mbc6(sa As String, sb As String, sd As String) As String 'chengfa jingdu daifh
Dim ja
fh1 = fhys(sa)
fh2 = fhys(sb)
If sa = 0 Or sb = 0 Then
mbc2 = 0
Else
ja = MbC(qdfh(sa), qdfh(sb))
If Val(Len(ja)) > Val(sd) Then
jb = Left(ja, Val(Len(ja)) - Val(sd))
If Val(fh1) * Val(fh2) > 0 Then
mbc2 = jb
Else
mbc2 = "-" & jb
End If
Else
mbc2 = 0
End If
End If
End Function
'去掉符号的程序
Private Function qdfh(sa As String) As String
If InStr(sa, "-") > 0 Then
qdfh = Mid(sa, 2)
Else
If InStr(sa, "+") > 0 Then
qdfh = Mid(sa, 2)
Else
qdfh = sa
End If
End If
End Function
'比较大小的程序
Public Function MBJC1(D1 As String, D2 As String) As String 'bijiao
If Len(D1) > Len(D2) Then
MBJC = 1
Else
If Len(D1) < Len(D2) Then
MBJC = -1
Else
If Len(D1) = Len(D2) And Len(D1) >= 10 Then
Dim x, Y
x = Len(D1) \ 4: Y = Len(D2) \ 4
Dim A() As String, B() As String
ReDim A(4 To 4 * x + 4)
ReDim B(4 To 4 * Y + 4)
If Val(Left(D1, Len(D1) - 4 * x)) > Val(Left(D2, Len(D2) - 4 * Y)) Then
MBJC = 1
Else
If Val(Left(D1, Len(D1) - 4 * x)) < Val(Left(D2, Len(D2) - 4 * Y)) Then
MBJC = -1
Else
For I = 4 To 4 * x Step 4
A(I) = Mid(D1, Len(D1) - I + 1, 4)
B(I) = Mid(D2, Len(D2) - I + 1, 4)
Next
J = 4 * x
Do While A(J) = B(J) And J >= 8
J = J - 4
Loop
If Val(A(J)) - Val(B(J)) > 0 Then
MBJC = 1
Else
If Val(A(J)) - Val(B(J)) < 0 Then
MBJC = -1
Else
MBJC = 0
End If
End If
End If
End If
End If
If Len(D1) < 10 Then
ja = Val(D1) - Val(D2)
If ja > 0 Then
MBJC = 1
Else
If ja = 0 Then
MBJC = 0
Else
MBJC = -1
End If
End If
End If
End If
End If
End Function
[此贴子已经被作者于2021-4-17 23:53编辑过]
