ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
123
返回列表 发新帖
楼主: lee1892

[Excel 程序开发] [开_145-2]计算根号2,比精度比速度[已总结]

[复制链接]

TA的精华主题

TA的得分主题

发表于 2017-12-12 17:18 | 显示全部楼层
改了一个网上的正整数开方公式,效果还可以。

正整数开方.zip

20.5 KB, 下载次数: 9

TA的精华主题

TA的得分主题

发表于 2017-12-13 11:14 | 显示全部楼层
1个自定义开方主函数,外加3个辅助自定义函数:

开方过程,完全模拟手工开方的逐位计算。
但为了计算方便,算式扩大5倍,这样就可以把乘20变为20*5=100,简化计算了。

开方过程:
1、 开方余数a,开方结果b初始化。
2、 余数a=N-b^2,,每次增加1个数位更新为a=(N-b^2)*100
3、 设 b的下一位是t,即b=b*10+t
      (b*10+t)^2=b^2*100+20*b*t+t*t=b^2*100+(20*b+t)*t
     
所以余数a=(N-b^2)*100-b^2*100-(20*b+t)*t=N-(20*b+t)*t

4.  每次增加位数需要减去(20*b*t+t*t)
   扩大5倍a=N*5-(20*b*5+t*5)*t=N*5-(b*100+t*5)*t 所以这样扩大5倍就可以简化b的计算,而不影响数据结果的正确性。


  1. Function LongSqr(n&, Optional d& = 100) '对于任意正整数n、 返回其小数长度为d的平方根
  2.     Dim a$, b$, j&, j1&, j2&, m&, p, t&, t1$, t2$
  3.    
  4.     p = Int(Sqr(n)) '利用自带函数开方取开方值整数部分
  5.     m = d + Len(p) + 2 '整数+小数的总位数<m
  6.    
  7.     a = 5 * (n - p * p) '第一次计算直接扣除开方整数部分 然后扩大5倍好算
  8.     b = p & 0 'b*10增加1位
  9.     j1 = Len(a): j2 = Len(b)
  10.    
  11.     Do While j2 < m '循环直至小数位足够
  12.         If j1 > j2 Or (j1 = j2 And a > b) Then 'a>b
  13.             
  14.             If j2 > 18 Then j = 18 Else j = j2 '取有效位数计算
  15.             t = -Int(1 - Left(a, j + j1 - j2) / Left(b, j)) '取当前有效个位商t
  16.             
  17.             For t = t To 2 Step -1 '倒序检查合适的商数t (保证a-(b+t)*t>0)
  18.                 t1 = LargeSum(b, t * 5) '(b+t*5)
  19.                 t2 = LargeMult(t1, t) '(b+t*5)*t
  20.                 j = Len(t2)
  21.                 If j1 > j Or (j1 = j And a > t2) Then Exit For '足够大时退出
  22.             Next
  23.             If t = 1 Then t2 = LargeSum(b, 5) 't=1时简化计算

  24.             a = LargeMinus(a, t2) 'a=a-b
  25.             b = LargeSum(b, t & "0") 'b+t
  26.             j1 = Len(a)
  27.         Else 'a<b
  28.             a = a & "00" 'a*100
  29.             b = b & "0" 'b*10 相应增加1位
  30.             j1 = j1 + 2: j2 = j2 + 1
  31.         End If
  32.     Loop
  33.    
  34.     LongSqr = p & "." & Mid(b, Len(p) + 1, d) '按指定小数位输出结果
  35. End Function
  36. Function LargeSum$(ByVal a$, ByVal b$)  '大数a+小数b
  37.     Dim i&, t$, t1$, t2$
  38.     If Len(a) <= Len(b) Then
  39.         LargeSum = Val(a) + Val(b)
  40.     Else
  41.         t1 = Left(a, Len(a) - Len(b)) '截取a前面超出b的部分不用计算
  42.         t2 = Val(Right(a, Len(b))) + Val(b) '仅计算尾部对齐b的部分
  43.         If Len(t2) > Len(b) Then '如果有进位
  44.             t = Left(t2, 1) '截取进位数字t
  45.             For i = Len(t1) To 1 Step -1 '倒序检查拼接
  46.                 If Mid(t1, i, 1) + t > 9 Then '超9时需进位
  47.                     Mid(t1, i, 1) = 0: t = 1 '本位归零、进位=1
  48.                 Else '不超9时直接相加然后退出
  49.                     Mid(t1, i, 1) = Mid(t1, i, 1) + t: Exit For
  50.                 End If
  51.             Next
  52.             If i = 0 Then t1 = 1 & t1 '检查至头部仍需进位时前面+1
  53.         End If
  54.         LargeSum = t1 & t2
  55.     End If
  56. End Function
  57. Function LargeMinus$(ByVal a$, ByVal b$)   '大数a-大数b
  58.     Dim i&, n0&, n1&, r$, s$, t, t0
  59.    
  60.     n1 = Len(a): n0 = Len(b)
  61.     If n1 < 29 Then LargeMinus = CDec(a) - CDec(b): Exit Function
  62.     r = String(28, "0"): t0 = CDec(1 & r)

  63.     For i = 1 To (n0 - 1) \ 28
  64.         t = t0 + t + CDec(Mid(a, n1 - i * 28 + 1, 28)) - CDec(Mid(b, n0 - i * 28 + 1, 28))
  65.         s = Right(r & t, 28) & s: If Len(t) > 28 Then t = 0 Else t = -1
  66.     Next

  67.     t = t - CDec(Left(b, n0 - i * 28 + 28))
  68.     For i = i To (n1 - 1) \ 28
  69.         t = t0 + t + CDec(Mid(a, n1 - i * 28 + 1, 28))
  70.         If Len(t) > 28 Then
  71.             LargeMinus = Left(a, n1 - i * 28) & Right(t, 28) & s: Exit Function
  72.         Else
  73.             s = Right(r & t, 28) & s: t = -1
  74.         End If
  75.     Next
  76.     s = (CDec(Left(a, n1 - i * 28 + 28)) + t) & s

  77.     For i = 1 To Len(s) - 1
  78.         If Mid(s, i, 1) > 0 Then Exit For
  79.     Next
  80.     LargeMinus = Mid(s, i)
  81. End Function
  82. Function LargeMult$(ByVal a$, ByVal b&)  '计算任意多位数的a 乘以单个数字b
  83.     Dim i&, m&, n&, s$, s0$, t$
  84.     s0 = String(27, "0")
  85.     n = Len(a): m = Int((n - 1) / 27)
  86.     For i = 1 To m
  87.         t = Right(s0 & CDec(Mid(a, n - 27 * i + 1, 27)) * b + Val(t), 28)
  88.         s = Right(t, 27) & s
  89.         t = Left(t, 1)
  90.     Next
  91.     LargeMult = CDec(Left(a, n - 27 * m)) * b + Val(t) & s
  92. End Function
复制代码

TA的精华主题

TA的得分主题

发表于 2017-12-13 14:01 | 显示全部楼层
这样效率高一点点,Do循环次数减少一些。
  1. Function LongSqr(n&, Optional d& = 100) '对于任意正整数n、 返回其小数长度为d的平方根
  2.     Dim a$, b$, j&, j1&, j2&, m&, p, t&, t1$, t2$

  3.     p = Int(Sqr(n)) '利用自带函数开方取开方值整数部分
  4.     m = d + Len(p) + 2 '整数+小数的总位数<m

  5.     a = (n - p * p) * 500 '第一次计算直接扣除开方整数部分 然后扩大5倍好算
  6.     b = p * 100 'b*100
  7.     j1 = Len(a): j2 = Len(b)

  8.     Do While j2 < m '循环直至小数位足够
  9.         Do Until j1 > j2 Or (j1 = j2 And a > b) '保证a>b
  10.             a = a & "00"
  11.             b = b & "0"
  12.             j1 = j1 + 2: j2 = j2 + 1
  13.         Loop
  14.         
  15.         If j2 > 18 Then j = 18 Else j = j2 '取有效位数计算
  16.         t = -Int(1 - Left(a, j + j1 - j2) / Left(b, j)) '取当前有效个位商t

  17.         For t = t To 2 Step -1 '倒序检查合适的商数t (保证余数a-(b+t*5)*t>0)
  18.             t1 = LargeSum(b, t * 5) '(b+t*5)
  19.             t2 = LargeMult(t1, t) '(b+t*5)*t =(2*b*10*t+t*t)*5=(b*100+t*5)*t
  20.             j = Len(t2)
  21.             If j1 > j Or (j1 = j And a > t2) Then Exit For '足够大余数>0时退出
  22.         Next
  23.         If t = 1 Then t2 = LargeSum(b, 5) 't=1时简化计算

  24.         a = LargeMinus(a, t2) & "00"  'a=(N-b^2)*5=(N-b^2)*5*100-[b^2*5*100+(b*100+t*5)*t]
  25.         b = LargeSum(b, t * 10) & "0" 'b=b"*10=(b'*10+t*10)*10=(b'+t)*100
  26.         '举例: b=(100+40)*10=1400 → =(1400+10)*10=14100 → =(14100+40)*10=141400
  27.         j1 = Len(a): j2 = j2 + 1
  28.     Loop

  29.     LongSqr = p & "." & Mid(b, Len(p) + 1, d) '按指定小数位输出结果
  30. End Function
复制代码
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-11-18 18:46 , Processed in 0.044620 second(s), 9 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

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