高精度乘法

pengyx

N位数乘M位数的乘法计算器（N、M为任意数哈）

dsmch

验证了一下，有小数的不适合，期待楼主继续完善

香川群子

帮楼主把代码改写成自定义函数，并补足了变量定义。

1. Function Tm1$(a$, b$) 'pengyx
   
2.     Dim a1&, b1&, ab&, bb&, i&, j&, jw&, k&, m&, s$, t$, w&, x$, y$, z&, zs$
   
3.     m = 7    '7位与7位相乘
   
4.    
   
5.     If Len(a) + Len(b) < 16 Then  '积的长度小于16位直接相乘
   
6.         s = Val(a) * Val(b)
   
7.     Else
   
8.         a1 = Len(a) Mod m: b1 = Len(b) Mod m
   
9.         If a1 <> 0 Then
   
10.             For i = 1 To m - a1
    
11.                 ab = ab + 1
    
12.                 a = a & "0"
    
13.             Next
    
14.         End If
    
15.         If b1 <> 0 Then
    
16.             For i = 1 To m - b1
    
17.                 bb = bb + 1
    
18.                 b = b & "0"
    
19.             Next
    
20.         End If 'a b长度补成Ｍ的倍数
    
21.         For i = 1 To Len(a) + Len(b) '初始化积
    
22.             s = s & "0"
    
23.             w = Len(s)
    
24.         Next
    
25.         a1 = Len(a) / m: b1 = Len(b) / m
    
26.         For i = 1 To a1
    
27.             x = Mid(a, (i - 1) * m + 1, m) '从数a中取m位
    
28.             For j = 1 To b1
    
29.                 y = Mid(b, (j - 1) * m + 1, m) '从数a中取m位
    
30.                 t = x * y '计算前m位的积t
    
31.                 For k = 1 To (i + j) * m - Len(t)
    
32.                     t = "0" & t
    
33.                 Next '对t定位
    
34.                 For k = 1 To Len(a) + Len(b) - Len(t)
    
35.                     t = t & "0"
    
36.                 Next '在t后面加0，将t补成a的长度+b的长度位数
    
37.                 For k = Len(a) + Len(b) To 1 Step -1
    
38.                     z = Val(Mid(s, k, 1)) + Val(Mid(t, k, 1)) + jw
    
39.                     If z > 9 Then
    
40.                         z = z - 10
    
41.                         jw = 1
    
42.                     Else
    
43.                         jw = 0
    
44.                     End If
    
45.                     zs = z & zs
    
46.                 Next '将每个t从右到左依次相加，将和的个位连成字符串，jw逢10进1
    
47.                 s = zs '字符串就是积
    
48.                 zs = "" '初始化字符串
    
49.             Next
    
50.         Next
    
51.         If Left(s, 1) = "0" Then '判断积的位数
    
52.             s = Mid(s, 2, Len(s) - ab - bb - 1)
    
53.         Else
    
54.             s = Mid(s, 1, Len(s) - ab - bb)
    
55.         End If
    
56.     End If
    
57.     Tm1 = s
    
58. End Function

复制代码

香川群子

分享一下我的【超长数位乘法】代码：

由于利用了CDec 10进制数进行计算，每次进行至少26位数的乘法，所以效率提高。
CDec类型数可以计算得到28位精度的结果，比一般计算的15位精度大多了。
计算速度比楼主的要快20-100倍以上。

1. Function TM2$(Na$, Nb$)
   
2.     Dim i&, j&, l&, la&, lb&
   
3.     If Na = 0 Or Nb = 0 Then TM2 = "0": Exit Function
   
4.     If Len(Na) < Len(Nb) Then TM2 = TM2(Nb, Na): Exit Function
   
5.     If Len(Nb) < 13 Then l = 26 - Len(Nb) Else l = 13
   
6.      
   
7.     la = (Len(Na) - 1) \ l: ReDim a(la)
   
8.     For i = 1 To la
   
9.         a(i - 1) = CDec(Mid(Na, Len(Na) - l * i + 1, l))
   
10.     Next
    
11.     a(la) = CDec(Mid(Na, 1, Len(Na) - l * la))
    
12.    
    
13.     lb = (Len(Nb) - 1) \ l: ReDim b(lb)
    
14.     For i = 1 To lb
    
15.         b(i - 1) = CDec(Mid(Nb, Len(Nb) - l * i + 1, l))
    
16.     Next
    
17.     b(lb) = CDec(Mid(Nb, 1, Len(Nb) - l * lb))
    
18.         
    
19.     ReDim c(la + lb)
    
20.     For i = 0 To la
    
21.         For j = 0 To lb
    
22.             c(la - i + lb - j) = c(la - i + lb - j) + a(i) * b(j)
    
23.         Next
    
24.     Next
    
25.    
    
26.     For i = la + lb To 1 Step -1
    
27.         If Len(c(i)) > l Then
    
28.             If i = 1 Then
    
29.                 c(0) = c(0) + Left(c(i), Len(c(i)) - l)
    
30.                 If Len(c(0)) > l Then c(0) = Left(c(0), Len(c(0)) - l) & Right(c(0), l)
    
31.             Else
    
32.                 c(i - 1) = Format(c(i - 1) + Left(c(i), Len(c(i)) - l), String(l, "0"))
    
33.             End If
    
34.             c(i) = Right(c(i), l)
    
35.         ElseIf Len(c(i)) < l Then
    
36.             c(i) = Format(c(i), String(l, "0"))
    
37.         End If
    
38.     Next
    
39.     TM2 = Join(c, "")
    
40. End Function

复制代码