Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 3446|回复: 3

[分享] 高精度乘法

[复制链接]
发表于 2015-8-21 22:46 | 显示全部楼层 |阅读模式
N位数乘M位数的乘法计算器(N、M为任意数哈)

高精度乘法.rar

8.91 KB, 下载次数: 28

评分

参与人数 1 +20 金币 +20 收起 理由
爱疯 + 20 + 20 感谢分享!

查看全部评分

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2015-8-21 22:54 | 显示全部楼层
验证了一下,有小数的不适合,期待楼主继续完善
回复

使用道具 举报

发表于 2015-8-23 16:25 | 显示全部楼层
帮楼主把代码改写成自定义函数,并补足了变量定义。
  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长度补成M的倍数
  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
复制代码

评分

参与人数 1 +20 金币 +20 收起 理由
爱疯 + 20 + 20 谢谢!

查看全部评分

回复

使用道具 举报

发表于 2015-8-23 16:28 | 显示全部楼层
本帖最后由 香川群子 于 2015-8-23 16:35 编辑

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

由于利用了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
复制代码

评分

参与人数 1 +40 金币 +40 收起 理由
爱疯 + 40 + 40 谢谢群子老师分享!

查看全部评分

回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-11-1 07:32 , Processed in 0.211754 second(s), 6 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表