设为首页收藏本站
简字体切换切换到宽版

ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步，快速开始

快捷登录

搜索
ExcelHome技术论坛»论坛 › Excel 技术交流与问答 › Excel VBA程序开发 › 自定义函数，位数超长数字的加减乘除计算。
EH技术汇-专业的职场技能充电站 妙哉！函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
12下一页
返回列表 发新帖
查看: 11460|回复: 18

[原创] 自定义函数，位数超长数字的加减乘除计算。

[复制链接]
香川群子

TA的精华主题

TA的得分主题
发表于 2011-8-1 16:53 | 显示全部楼层 |阅读模式
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册★
本帖已被收录到知识树中，索引项：自定义函数开发
Excel在计算超过15位的数值时，会自动对15位以后的数字进行四舍五入处理，仅保留15位。

一般计算的精度是足够足够了，但有时候需要对每一个数位的数字进行判断时，
比如奇偶判断、求余数时，显然就有问题了。


我用VBA自定义函数的方式，做了几个函数，可以基本上解决这个问题。
即，可以对很长很长的数字（文本形式数值），做全部数位的计算。


首先是加减法：
  1. Function PM(Na, Nb) '位数很多的文本型数的加減計算
  2.     ka = IIf(Left(Na, 1) = "-", "-", "+")
  3.     la = IIf(InStr(Na, ".") = 0, Len(Na), InStr(Na, ".") - 1)
  4.     Pa = Len(Na) - la
  5.    
  6.     kb = IIf(Left(Nb, 1) = "-", "-", "+")
  7.     lb = IIf(InStr(Nb, ".") = 0, Len(Nb), InStr(Nb, ".") - 1)
  8.     Pb = Len(Nb) - lb
  9.    
  10.     p = IIf(Pa > Pb, Pa, Pb)
  11.     Ma = la + p
  12.     Mb = lb + p '- IIf(IsNumeric(Left(Nb, 1)), 0, 1)
  13.     l = IIf(Ma > Mb, Ma, Mb)
  14.    
  15.     ReDim a(l, 4)
  16.     For i = 0 To l
  17.         If i < Ma - IIf(IsNumeric(Left(Na, 1)), 0, 1) Then a(i, 1) = Val(Mid(Na, Ma - i, 1))
  18.         If i < Mb - IIf(IsNumeric(Left(Nb, 1)), 0, 1) Then a(i, 2) = Val(Mid(Nb, Mb - i, 1))
  19.         If i <> p - 1 And a(i, 1) <> "" Then If Not IsNumeric(a(i, 1)) Then PM = "Err": Exit Function
  20.         If i <> p - 1 And a(i, 2) <> "" Then If Not IsNumeric(a(i, 2)) Then PM = "Err": Exit Function
  21.     Next i
  22.    
  23.         For i = 0 To l - 1
  24.             If a(i, 0) + a(i, 1) + a(i, 2) > 9 Then
  25.                 a(i, 0) = a(i, 0) + a(i, 1) + a(i, 2) - 10
  26.                 If i + 1 = p - 1 Then a(i + 2, 0) = 1 Else a(i + 1, 0) = 1
  27.             Else
  28.                 a(i, 0) = a(i, 0) + a(i, 1) + a(i, 2)
  29.             End If
  30.             'MT0 = a(i, 0) & MT0
  31.             
  32.             If a(i, 3) + a(i, 1) - a(i, 2) < 0 Then
  33.                 a(i, 3) = a(i, 3) + a(i, 1) - a(i, 2) + 10
  34.                 If i + 1 = p - 1 Then a(i + 2, 3) = -1 Else a(i + 1, 3) = -1
  35.             Else
  36.                 a(i, 3) = a(i, 3) + a(i, 1) - a(i, 2)
  37.             End If
  38.             'MT1 = a(i, 3) & MT1
  39.             
  40.             If a(i, 4) - a(i, 1) + a(i, 2) < 0 Then
  41.                 a(i, 4) = a(i, 4) - a(i, 1) + a(i, 2) + 10
  42.                 If i + 1 = p - 1 Then a(i + 2, 4) = -1 Else a(i + 1, 4) = -1
  43.             Else
  44.                 a(i, 4) = a(i, 4) - a(i, 1) + a(i, 2)
  45.             End If
  46.             'MT2 = a(i, 4) & MT2
  47.             
  48.             If i + 1 = p - 1 Then
  49.                 a(i + 1, 0) = "."
  50.                 a(i + 1, 3) = "."
  51.                 a(i + 1, 4) = "."
  52.                 'MT0 = "." & MT0
  53.                 'MT1 = "." & MT1
  54.                 'MT2 = "." & MT2
  55.                 i = i + 1
  56.             End If
  57.         Next
  58.    
  59.     If ka = kb Then
  60.         H = 0
  61.         k = ka
  62.     Else
  63.         If a(l, 3) < 0 Then
  64.             H = 4
  65.             k = kb
  66.         Else
  67.             H = 3
  68.             k = ka
  69.         End If
  70.     End If
  71.    
  72.     pt = ""
  73.     ppw = ""
  74.     For i = 0 To p - 1
  75.         If a(i, H) > 0 Or ppw <> "" Then ppw = a(i, H) & ppw
  76.     Next
  77.     If ppw = "." Then ppw = ""
  78.    
  79.     For i = l To p + 1 Step -1
  80.         If a(i, H) > 0 Or pt <> "" Then pt = pt & a(i, H)
  81.     Next
  82.     pt = pt & a(i, H)
  83.     If pt = 0 Then k = ""
  84.     PM = IIf(k = "-", k, "") & pt & ppw
  85. End Function
复制代码
上面这个加减计算，可以处理正负号数值，以及小数点数值。


下面同样是长数位数的加减计算，但是只能处理正整数，不处理小数点和正负号。
  1. Function PM3(Na, Nb, Optional k = 0)
  2. '加減計算，k=0时做加法，k=3时计算Na-Nb
  3. '请保证计算对象为正整数，且Na>=Nb   
  4.     l = IIf(Len(Na) > Len(Nb), Len(Na), Len(Nb))
  5.    
  6.     ReDim a(l, 3)
  7.     For i = 0 To Len(Na) - 1
  8.         a(i, 1) = Val(Mid(Na, Len(Na) - i, 1))
  9.     Next i
  10.     For i = 0 To Len(Nb) - 1
  11.         a(i, 2) = Val(Mid(Nb, Len(Nb) - i, 1))
  12.     Next i
  13.    
  14.     For i = 0 To l - 1
  15.         If k = 0 Then
  16.             If a(i, 0) + a(i, 1) + a(i, 2) > 9 Then
  17.                 a(i, 0) = a(i, 0) + a(i, 1) + a(i, 2) - 10
  18.                 a(i + 1, 0) = 1
  19.             Else
  20.                 a(i, 0) = a(i, 0) + a(i, 1) + a(i, 2)
  21.             End If
  22.         ElseIf k = 3 Then
  23.             If a(i, 3) + a(i, 1) - a(i, 2) < 0 Then
  24.                 a(i, 3) = a(i, 3) + a(i, 1) - a(i, 2) + 10
  25.                 a(i + 1, 3) = -1
  26.             Else
  27.                 a(i, 3) = a(i, 3) + a(i, 1) - a(i, 2)
  28.             End If
  29.         End If
  30.     Next
  31.    
  32.     For i = l To 0 Step -1
  33.         If a(i, k) > 0 Or PM3 <> "" Then PM3 = PM3 & a(i, k)
  34.     Next
  35.     If PM3 = "" Then PM3 = "0"
  36. End Function
复制代码
函数, 计算, 自定义, 定义, 位数

评分

2

查看全部评分

回复

举报

香川群子

TA的精华主题

TA的得分主题
 楼主| 发表于 2011-8-1 16:56 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册★
下面是很长位数的乘法。可以处理正负数和小数点
  1. Function TM(Na, Nb, Optional l = 6, Optional w = "") '標準乗算(正負、小数点)、桁数区分可
  2.     If l = 0 Or l > 6 Then l = 6
  3.     If Na = 0 Or Nb = 0 Then TM = "0": Exit Function
  4.    
  5.     f = IIf(Left(Na, 1) = "-", IIf(Left(Nb, 1) = "-", "+", "-"), IIf(Left(Nb, 1) = "-", "-", "+"))
  6.     If Not IsNumeric(Left(Na, 1)) Then Na = Mid(Na, 2, Len(Na))
  7.     If Not IsNumeric(Left(Nb, 1)) Then Nb = Mid(Nb, 2, Len(Nb))
  8.    
  9.     p = IIf(InStr(Na, ".") = 0, 0, Len(Na) - InStr(Na, ".")) + IIf(InStr(Nb, ".") = 0, 0, Len(Nb) - InStr(Nb, "."))
  10.     Na = Replace(Na, ".", "")
  11.     Nb = Replace(Nb, ".", "")
  12.     If p > 0 Then w = ""
  13.    
  14.     la = (Len(Na) - 1) \ l
  15.     ReDim a(la)
  16. '    For i = 0 To la - 1
  17. '        a(i) = Mid(Na, Len(Na) - l * i - l + 1, l)
  18. '    Next
  19.     For i = 1 To la
  20.         a(i - 1) = Mid(Na, Len(Na) - l * i + 1, l)
  21.     Next
  22.     a(la) = Mid(Na, 1, Len(Na) - l * la)
  23.    
  24.     lb = (Len(Nb) - 1) \ l
  25.     ReDim B(lb)
  26.     For i = 1 To lb
  27.         B(i - 1) = Mid(Nb, Len(Nb) - l * i + 1, l)
  28.     Next
  29.     B(lb) = Mid(Nb, 1, Len(Nb) - l * lb)
  30.    
  31.     ReDim C(la + lb)
  32.     For i = 0 To la
  33.         For j = 0 To lb
  34.             C(la - i + lb - j) = C(la - i + lb - j) + a(i) * B(j)
  35.         Next
  36.     Next
  37.    
  38.     For i = la + lb To 1 Step -1
  39.         If Len(C(i)) > l Then
  40.             If i = 1 Then
  41.                 C(0) = C(0) + Left(C(i), Len(C(i)) - l)
  42.             Else
  43.                 C(i - 1) = Format(C(i - 1) + Left(C(i), Len(C(i)) - l), String(l, "0"))
  44.             End If
  45.             C(i) = Right(C(i), l)
  46.         Else
  47.             C(i) = Format(C(i), String(l, "0"))
  48.         End If
  49.     Next
  50.     If Len(C(0)) > l Then C(0) = Left(C(0), Len(C(0)) - l) & w & Right(C(0), l) Else C(0) = Format(C(0), String(l, "0"))
  51.             
  52.     If p > 0 Then
  53.         TM = Join(C, "")
  54.         TM = Left(TM, Len(TM) - p) & "." & Right(TM, p)
  55.         For i = 1 To p
  56.             If Right(TM, 1) = "0" Then TM = Left(TM, Len(TM) - 1) Else Exit For
  57.         Next
  58.         If Right(TM, 1) = "." Then TM = Left(TM, Len(TM) - 1)
  59.         For i = 1 To l
  60.             If Left(TM, 1) = "0" And Left(TM, 2) <> "0." Then TM = Right(TM, Len(TM) - 1) Else Exit For
  61.         Next
  62.     Else
  63.         TM = Join(C, w)
  64.     End If
  65.     TM = IIf(f = "-", "-", "") & TM
  66. End Function

复制代码
只能处理正整数的乘法
  1. Function TM2(Na, Nb) '只能处理正整数的乘法
  2.     l = 6
  3.     If Na = 0 Or Nb = 0 Then TM2 = "0": Exit Function
  4.    
  5.     la = (Len(Na) - 1) \ l
  6.     ReDim a(la)
  7.     For i = 0 To la - 1
  8.         a(i) = Mid(Na, Len(Na) - l * i - l + 1, l)
  9.     Next
  10.     a(la) = Mid(Na, 1, Len(Na) - l * la)
  11.    
  12.     lb = (Len(Nb) - 1) \ l
  13.     ReDim B(lb)
  14.     For i = 0 To lb - 1
  15.         B(i) = Mid(Nb, Len(Nb) - l * i - l + 1, l)
  16.     Next
  17.     B(lb) = 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.         Else
  36.             C(i) = Format(C(i), String(l, "0"))
  37.         End If
  38.     Next
  39.     TM2 = Join(C, "")
  40. End Function
复制代码

[ 本帖最后由 香川群子 于 2011-8-2 11:28 编辑 ]
回复

举报

a814153
头像被屏蔽

TA的精华主题

TA的得分主题
发表于 2011-8-1 16:59 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册★
提示: 作者被禁止或删除 内容自动屏蔽
回复

举报

香川群子

TA的精华主题

TA的得分主题
 楼主| 发表于 2011-8-1 17:03 | 显示全部楼层
[广告] ★用Excel做企业管理系统，Excel服务器学习和下载★
本帖最后由 香川群子 于 2011-8-25 13:36 编辑

再下面是很长位数的除法计算。
除法计算，可分别得到商和余数两个结果。
默认计算结果为商，如果k参数输入其它非空白值，则输出余数结果。

另外，可以指定小数点后位数
即，计算到小数点第几位时停止计算而输出结果。

默认为0，举例，20/3=6.77……时，如指定p参数=3时，结果为 6.777，默认p=0时结果为 6）

  2. Function DV(Na, Nb, Optional k = "", Optional p = 0) '標準除算、黙認 商、その他 余数　P=小数点位数
  3.     If Nb = 0 Then DV = "/0 Err": Exit Function
  4.     If Na = 0 Then DV = "0": Exit Function
  5.    
  6.     f = IIf(Left(Na, 1) = "-", IIf(Left(Nb, 1) = "-", "+", "-"), IIf(Left(Nb, 1) = "-", "-", "+"))
  7.     If Not IsNumeric(Left(Na, 1)) Then Na = Mid(Na, 2, Len(Na))
  8.     If Not IsNumeric(Left(Nb, 1)) Then Nb = Mid(Nb, 2, Len(Nb))
  9.    
  10.     Pa = IIf(InStr(Na, ".") = 0, 0, Len(Na) - InStr(Na, "."))
  11.     Pb = IIf(InStr(Nb, ".") = 0, 0, Len(Nb) - InStr(Nb, "."))
  12.     If Left(Na, 2) = "0." Then Na = "0" & Replace(Na, "0.", "") Else Na = "0" & Replace(Na, ".", "")
  13.     la = Len(Na)
  14.     Pc = IIf(Pb - Pa + p > 0, Pb - Pa + p, 0)
  15.     Na = Na & String(Pc, "0")
  16.     If Left(Nb, 2) = "0." Then Nb = Replace(Nb, "0.", "") Else Nb = Replace(Nb, ".", "")
  17.     lb = Len(Nb)
  18.    
  19.     If lb > 6 Then l = 6 Else l = lb
  20.    
  21.     For i = 1 To (la - Pa) - (lb - Pb) + p
  22.         d = Left(Na, l + 1) \ Left(Nb, l)
  23. '        T0 = Left(Na, lb + 1)
  24. '        T1 = Format(TM2(Nb, d), String(lb + 1, "0"))
  25. '        If T0 < T1 Then d = d - 1
  26. '        If Left(Na, lb + 1) < Format(TM2(Nb, d), String(lb + 1, "0")) Then d = d - 1
  27.         '发现Format公式结果错误。14位以后全是0无法正确显示，只能改为Right函数进行。
  28.         If Left(Na, lb + 1) < Right(String(lb + 1, "0") & TM2(Nb, d), lb + 1) Then d = d - 1
  29. '        T2 = Format(PM3(Left(Na, lb + 1), TM2(Nb, d), 3), String(lb, "0"))
  30. '        T3 = Mid(Na, lb + 2, Len(Na))
  31. '        Na = T2 & T3
  32. '        Na = Format(PM3(Left(Na, lb + 1), TM2(Nb, d)), String(lb, "0")) & Mid(Na, lb + 2, Len(Na))
  33.         Na = Right(String(lb, "0") & PM3(Left(Na, lb + 1), TM2(Nb, d)), lb) & Mid(Na, lb + 2, Len(Na))
  34.         If d = 0 And DV = "" Then Else DV = DV & d
  35.     Next
  36.    
  37.     If k = "" Then
  38.         If DV = "" Then DV = "0": Exit Function
  39.         For i = 1 To Len(DV)
  40.             If Mid(DV, i, 1) > 0 Then DV = Mid(DV, i, Len(DV)): Exit For
  41.         Next
  42.    
  43.         If p > 0 Then
  44.             If Len(DV) > p Then
  45.                 DV = Left(DV, Len(DV) - p) & "." & Right(DV, p)
  46.             Else
  47.                 DV = "0." & String(p - Len(DV), "0") & DV
  48.             End If
  49.         ElseIf p < 0 Then
  50.             DV = DV & String(-p, "0")
  51.         End If
  52.     Else
  53.         If Left(Na, 1) = 0 Then Na = Mid(Na, 2, Len(Na))
  54.         Pd = IIf(Pc = 0, Pa, p + Pb)
  55.         If Pd > 0 Then
  56.             If Len(Na) > Pd Then
  57.                 DV = Left(Na, Len(Na) - Pd) & "." & Right(Na, Pd)
  58.             Else
  59.                 DV = "0." & String(Pd - Len(Na), "0") & Na
  60.             End If
  61.         Else
  62.             DV = Na
  63.         End If
  64.     End If
  65.    
  66. '    If InStr(DV, ".") > 0 Then
  67. '        For i = Len(DV) To 1 Step -1
  68. '            If Mid(DV, i, 1) > 0 Then DV = Left(DV, i): Exit For
  69. '        Next
  70. '    End If
  71.    
  72.     DV = IIf(f = "-", f, "") & DV
  73. End Function
复制代码
只计算正整数除法的代码：
  1. Function DV0(Na, Nb, Optional k = "") '割算、商、余数計算
  2.     Na = "0" & Na
  3.     la = Len(Na)
  4.     lb = Len(Nb)
  5.     If lb > 6 Then l = 6 Else l = lb
  6.    
  7.     For i = 1 To la - lb
  8.         d = Left(Na, l + 1) \ Left(Nb, l)
  9.         If Left(Na, lb + 1) < Format(TM2(Nb, d), String(lb + 1, "0")) Then d = d - 1
  10.         Na = Format(PM3(Left(Na, lb + 1), TM2(Nb, d), 3), String(lb, "0")) & Mid(Na, lb + 2, Len(Na))
  11.         If Not (d = 0 And DV0 = "") Then DV0 = DV0 & d
  12.     Next
  13.     If k <> "" Then DV0 = Na
  14. End Function
复制代码
回复

举报

香川群子

TA的精华主题

TA的得分主题
 楼主| 发表于 2011-8-1 17:18 | 显示全部楼层
[广告] ★ExcelHome默写助手 - 不用妈妈陪的默写神器 · Word/WPS插件 · 自定义默写单 · 自定义描红字帖★
其实，最后一个只能计算正整数除法的自定义函数，

有一个巨大的好处 → 可以计算大数值（很长位数的文本型数值）的余数。

而Excel的自带mod函数，是处理不了很大的数值的。

如，=mod(268435455,2) 能计算，但=mod(268435456,2)就已经不能计算了。
即只能处理小于 2^28的数值。

呵呵。
回复

举报

a814153
头像被屏蔽

TA的精华主题

TA的得分主题
发表于 2011-8-1 17:30 | 显示全部楼层
[广告] ★会Excel,就能做支持PC、手机、Web、App、Windows、安卓、IOS、Linux信息一体化的各种管理系统 ★
提示: 作者被禁止或删除 内容自动屏蔽
回复

举报

香川群子

TA的精华主题

TA的得分主题
 楼主| 发表于 2011-8-25 13:00 | 显示全部楼层
[广告] ★会Excel,就能做支持PC、手机、Web、App、Windows、安卓、IOS、Linux信息一体化的各种管理系统 ★
加法改版
1. 不是每次1个数位的计算，而是以长度12为单位计算，这样加快了速度。
2. 增加了k参数，可以指定结果：
  k=0 按实际正负号计算。
  k=1 指定输出Na+Nb的正结果
  k=2 指定输出-(Na+Nb)结果
  k=3 指定输出Na-Nb的结果
  k=4 指定输出Nb-Na的结果
  1. Function PM(Na, Nb, Optional k = 0) '桁数多い文字表示数字の加減計算
  2.     ka = IIf(Left(Na, 1) = "-", "-", "+")
  3.     If Not IsNumeric(Left(Na, 1)) Then Na = Mid(Na, 2, Len(Na))
  4.     Pa = IIf(InStr(Na, ".") = 0, 0, Len(Na) - InStr(Na, "."))
  5.     If Left(Na, 2) = "0." Then Na = Replace(Na, "0.", "") Else Na = Replace(Na, ".", "")
  6.    
  7.     kb = IIf(Left(Nb, 1) = "-", "-", "+")
  8.     If Not IsNumeric(Left(Nb, 1)) Then Nb = Mid(Nb, 2, Len(Nb))
  9.     Pb = IIf(InStr(Nb, ".") = 0, 0, Len(Nb) - InStr(Nb, "."))
  10.     If Left(Nb, 2) = "0." Then Nb = Replace(Nb, "0.", "") Else Nb = Replace(Nb, ".", "")
  11.    
  12.     If Pa > Pb Then p = Pa Else p = Pb
  13.     Na = Na & String(p - Pa, "0")
  14.     Nb = Nb & String(p - Pb, "0")
  15.    
  16.     l = IIf(Len(Na) > Len(Nb), Len(Na) + 1, Len(Nb) + 1) \ 12
  17.     ReDim a(l + 2, 4)
  18.     For i = 1 To l + 1
  19.         If i * 12 <= Len(Na) Then a(i, 1) = Mid(Na, Len(Na) - i * 12 + 1, 12) Else If i = Len(Na) \ 12 + 1 Then a(i, 1) = Left(Na, Len(Na) - (i - 1) * 12)
  20.         If i * 12 <= Len(Nb) Then a(i, 2) = Mid(Nb, Len(Nb) - i * 12 + 1, 12) Else If i = Len(Nb) \ 12 + 1 Then a(i, 2) = Left(Nb, Len(Nb) - (i - 1) * 12)
  21.         
  22.         If Val(a(i, 0)) + Val(a(i, 1)) + Val(a(i, 2)) < 10 ^ 12 Then a(i, 0) = Val(a(i, 0)) + Val(a(i, 1)) + Val(a(i, 2)) Else a(i + 1, 0) = 1: a(i, 0) = Val(a(i, 0)) + Val(a(i, 1)) + Val(a(i, 2)) - 10 ^ 12
  23.         a(0, 0) = Right(String(12, "0") & a(i, 0), 12) & a(0, 0)
  24.         
  25.         If Val(a(i, 3)) + Val(a(i, 1)) < Val(a(i, 2)) Then a(i + 1, 3) = -1: a(i, 3) = 10 ^ 12 + Val(a(i, 3)) + Val(a(i, 1)) - Val(a(i, 2)) Else a(i, 3) = Val(a(i, 3)) + Val(a(i, 1)) - Val(a(i, 2))
  26.         a(0, 3) = Right(String(12, "0") & a(i, 3), 12) & a(0, 3)
  27.         
  28.         If Val(a(i, 4)) + Val(a(i, 2)) < Val(a(i, 1)) Then a(i + 1, 4) = -1: a(i, 4) = 10 ^ 12 + Val(a(i, 4)) + Val(a(i, 2)) - Val(a(i, 1)) Else a(i, 4) = Val(a(i, 4)) + Val(a(i, 2)) - Val(a(i, 1))
  29.         a(0, 4) = Right(String(12, "0") & a(i, 4), 12) & a(0, 4)
  30.     Next i
  31.    
  32.     a(0, 0) = a(l + 2, 0) & a(0, 0)
  33.     a(0, 3) = a(l + 2, 3) & a(0, 3)
  34.     a(0, 4) = a(l + 2, 4) & a(0, 4)
  35.    
  36.     If p > 0 Then
  37.         a(0, 0) = Left(a(0, 0), Len(a(0, 0)) - p) & "." & Right(a(0, 0), p)
  38.         For i = 1 To (l + 1) * 12
  39.             If Right(a(0, 0), 1) = "0" Then a(0, 0) = Left(a(0, 0), Len(a(0, 0)) - 1) Else Exit For
  40.         Next
  41.         If Right(a(0, 0), 1) = "." Then a(0, 0) = Left(a(0, 0), Len(a(0, 0)) - 1)
  42.         
  43.         a(0, 3) = Left(a(0, 3), Len(a(0, 3)) - p) & "." & Right(a(0, 3), p)
  44.         For i = 1 To (l + 1) * 12
  45.             If Right(a(0, 3), 1) = "0" Then a(0, 3) = Left(a(0, 3), Len(a(0, 3)) - 1) Else Exit For
  46.         Next
  47.         If Right(a(0, 3), 1) = "." Then a(0, 3) = Left(a(0, 3), Len(a(0, 3)) - 1)
  48.         
  49.         a(0, 4) = Left(a(0, 4), Len(a(0, 4)) - p) & "." & Right(a(0, 4), p)
  50.         For i = 1 To (l + 1) * 12
  51.             If Right(a(0, 4), 1) = "0" Then a(0, 4) = Left(a(0, 4), Len(a(0, 4)) - 1) Else Exit For
  52.         Next
  53.         If Right(a(0, 4), 1) = "." Then a(0, 4) = Left(a(0, 4), Len(a(0, 4)) - 1)
  54.         
  55.     End If
  56.    
  57.     For i = 1 To (l + 1) * 12
  58.         If Left(a(0, 0), 1) = "0" And Left(a(0, 0), 2) <> "0." Then a(0, 0) = Right(a(0, 0), Len(a(0, 0)) - 1) Else Exit For
  59.     Next
  60.     For i = 1 To (l + 1) * 12
  61.         If Left(a(0, 3), 1) = "0" And Left(a(0, 3), 2) <> "0." Then a(0, 3) = Right(a(0, 3), Len(a(0, 3)) - 1) Else Exit For
  62.     Next
  63.     For i = 1 To (l + 1) * 12
  64.         If Left(a(0, 4), 1) = "0" And Left(a(0, 4), 2) <> "0." Then a(0, 4) = Right(a(0, 4), Len(a(0, 4)) - 1) Else Exit For
  65.     Next
  66.    
  67.     If Left(a(0, 3), 1) = "-" Then a(0, 3) = "-" & a(0, 4)
  68.     If Left(a(0, 4), 1) = "-" Then a(0, 4) = "-" & a(0, 3)
  69.    
  70.     If k = 0 Then
  71.         If ka = "+" And kb = "+" Then
  72.             PM = a(0, 0)
  73.         ElseIf ka = "+" And kb = "-" Then
  74.             PM = a(0, 3)
  75.         ElseIf ka = "-" And kb = "+" Then
  76.             PM = a(0, 4)
  77.         ElseIf ka = "-" And kb = "-" Then
  78.             PM = "-" & a(0, 0)
  79.         End If
  80.     ElseIf k = 1 Then
  81.         PM = a(0, 0)
  82.     ElseIf k = 2 Then
  83.         PM = "-" & a(0, 0)
  84.     ElseIf k = 3 Then
  85.         PM = a(0, 3)
  86.     ElseIf k = 4 Then
  87.         PM = a(0, 4)
  88.     End If
  89.    
  90. End Function
复制代码
回复

举报

香川群子

TA的精华主题

TA的得分主题
 楼主| 发表于 2011-8-25 13:03 | 显示全部楼层
[广告] ★会Excel,就能做支持PC、手机、Web、App、Windows、安卓、IOS、Linux信息一体化的各种管理系统 ★
仅仅用来计算Na-Nb的【减法简化版】。

后面的除法需要用到的……
  1. Function PM2(Na, Nb) '桁数多い文字表示数字の減計算
  2.     l = (Len(Na) + 1) \ 12
  3.     ReDim a(l + 1, 2)
  4.     For i = 1 To l + 1
  5.         If i * 12 <= Len(Na) Then a(i, 1) = Mid(Na, Len(Na) - i * 12 + 1, 12) Else If i = Len(Na) \ 12 + 1 Then a(i, 1) = Left(Na, Len(Na) - (i - 1) * 12)
  6.         If i * 12 <= Len(Nb) Then a(i, 2) = Mid(Nb, Len(Nb) - i * 12 + 1, 12) Else If i = Len(Nb) \ 12 + 1 Then a(i, 2) = Left(Nb, Len(Nb) - (i - 1) * 12)
  7.         
  8.         If Val(a(i, 0)) + Val(a(i, 1)) < Val(a(i, 2)) Then a(i + 1, 0) = -1: a(i, 0) = 10 ^ 12 + Val(a(i, 0)) + Val(a(i, 1)) - Val(a(i, 2)) Else a(i, 0) = Val(a(i, 0)) + Val(a(i, 1)) - Val(a(i, 2))
  9.         a(0, 0) = Right(String(12, "0") & a(i, 0), 12) & a(0, 0)
  10.     Next i
  11.    
  12.     For i = 1 To Len(a(0, 0))
  13.         If Mid(a(0, 0), i, 1) > 0 Then a(0, 0) = Mid(a(0, 0), i, Len(a(0, 0))): PM2 = a(0, 0): Exit Function
  14.     Next
  15.    
  16.     PM2 = 0
  17.    
  18. End Function
复制代码
回复

举报

香川群子

TA的精华主题

TA的得分主题
 楼主| 发表于 2011-8-25 13:20 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册★
仅仅使用变量，没有使用数组的【减法】简便计算：
  1. Function PM3(Na, Nb) '桁数多い文字表示数字の減計算
  2.     For i = 1 To Len(Nb) \ 12
  3.         Ta = Mid(Na, Len(Na) - i * 12 + 1, 12)
  4.         Tb = Mid(Nb, Len(Nb) - i * 12 + 1, 12)
  5.         If t + Val(Ta) < Val(Tb) Then
  6.             PM3 = Right(String(12, "0") & (10 ^ 12 + t + Val(Ta) - Val(Tb)), 12) & PM3
  7.             t = -1
  8.         Else
  9.             PM3 = Right(String(12, "0") & (t + Val(Ta) - Val(Tb)), 12) & PM3
  10.         End If
  11.     Next
  12.    
  13.     Tb = Left(Nb, Len(Nb) Mod 12)
  14.     If Len(Na) = Len(Nb) Then
  15.         Ta = Mid(Na, Len(Na) - Len(Nb) + 1, Len(Tb))
  16.     Else
  17.         Ta = Mid(Na, Len(Na) - Len(Nb), Len(Tb) + 1)
  18.     End If
  19.     PM3 = Left(Na, Len(Na) - Len(Ta) - (Len(Nb) \ 12) * 12) & Right(String(Len(Tb), "0") & (t + Val(Ta) - Val(Tb)), Len(Ta)) & PM3
  20.    
  21.     For i = 1 To Len(PM3)
  22.         If Mid(PM3, i, 1) > 0 Then PM3 = Mid(PM3, i, Len(PM3)): Exit Function
  23.     Next
  24.     PM3 = 0
  25. End Function
复制代码
这个速度更快一点。
回复

举报

香川群子

TA的精华主题

TA的得分主题
 楼主| 发表于 2011-8-25 13:27 | 显示全部楼层
[广告] ★会Excel,就能做支持PC、手机、Web、App、Windows、安卓、IOS、Linux信息一体化的各种管理系统 ★
除法的改良。
一次计算得到商的12位，提高了速度。
  1. Function DV(Na, Nb, Optional k = "", Optional p = 0) 'k="" 商、k=1 余数　P=小数点位数
  2.     If Nb = 0 Then DV = "/0 Err": Exit Function
  3.     If Na = 0 Then DV = "0": Exit Function

  5.     f = IIf(Left(Na, 1) = "-", IIf(Left(Nb, 1) = "-", "+", "-"), IIf(Left(Nb, 1) = "-", "-", "+"))
  6.     If Not IsNumeric(Left(Na, 1)) Then Na = Mid(Na, 2, Len(Na))
  7.     If Not IsNumeric(Left(Nb, 1)) Then Nb = Mid(Nb, 2, Len(Nb))

  9.     Pa = IIf(InStr(Na, ".") = 0, 0, Len(Na) - InStr(Na, "."))
  10.     Pb = IIf(InStr(Nb, ".") = 0, 0, Len(Nb) - InStr(Nb, "."))
  11.    
  12.     If Left(Na, 2) = "0." Then Na = "0" & Replace(Na, "0.", "") Else Na = "0" & Replace(Na, ".", "")
  13.     Pc = IIf(Pb - Pa + p > 0, Pb - Pa + p, 0)
  14.     Na = Na & String(Pc, "0")
  15.     Nc = Na
  16.     la = Len(Na)
  17.    
  18.     If Left(Nb, 2) = "0." Then Nb = Replace(Nb, "0.", "") Else Nb = Replace(Nb, ".", "")
  19.     lb = Len(Nb)
  20.    
  21.     t = (la - Pa) - (lb - Pb) - Pc
  22.     For i = 1 To (t + p - 1) \ 12 + 1
  23.         If Len(Na) < lb + 12 Then Na = Na & String(lb + 12 - Len(Na), "0")
  24.         d = Int(Left(Na, lb + 12) / Nb)
  25.         If Len(d) < 12 Then d = Right(String(12, "0") & d, 12)
  26.         Na = Right(String(lb, "0") & PM3(Left(Na, lb + 12), TM2(Nb, d)), lb) & Mid(Na, lb + 12 + 1, Len(Na))
  27.         DV = DV & d
  28.     Next
  29.    
  30.         
  31.     If k = "" Then
  32.         If p + t <= 0 Then DV = "0": Exit Function
  33.         
  34.         If p > 0 Then
  35.             If t <= 0 Then
  36.                 DV = "0." & String(-t, "0") & Left(DV, p + t)
  37.             Else
  38.                 DV = Left(DV, t) & "." & Mid(DV, t + 1, p)
  39.             End If
  40.         Else
  41.             DV = Left(DV, t + p) & String(-p, "0")
  42.         End If
  43.    
  44.     Else
  45.         If p + t <= 0 Then
  46.             DV = Nc
  47.         Else
  48.             If p < 0 Then
  49.                 DV = PM3(Nc, TM2(Nb, Left(DV, t + p) & String(-p, "0")), 3)
  50.                 If Len(DV) > Pa Then
  51.                     DV = Left(DV, Len(DV) - Pa) & "." & Right(DV, Pa)
  52.                 Else
  53.                     DV = "0." & String(Pa - Len(DV), "0") & DV
  54.                 End If
  55.             Else
  56.                 DV = PM3(Nc, TM2(Nb, Left(DV, t + p)), 3)
  57.                 If Len(DV) > p Then
  58.                     DV = Left(DV, Len(DV) - p) & "." & Right(DV, p)
  59.                 Else
  60.                     DV = "0." & String(p - Len(DV), "0") & DV
  61.                 End If
  62.             End If
  63.         End If
  64.     End If
  65.         
  66.     For i = 1 To Len(DV)
  67.         If Left(DV, 1) = "0" And Left(DV, 2) <> "0." Then DV = Right(DV, Len(DV) - 1) Else Exit For
  68.     Next

  70.     If InStr(DV, ".") > 0 Then
  71.         For i = Len(DV) To 1 Step -1
  72.             If Mid(DV, i, 1) > 0 Then DV = Left(DV, i): Exit For
  73.         Next
  74.     End If
  75.     If Right(DV, 1) = "." Then DV = Left(DV, Len(DV) - 1)
  76.     If DV <> 0 Then DV = IIf(f = "-", f, "") & DV
  77. End Function
复制代码

评分

1

查看全部评分

回复

举报

下一页 »
12下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-5-20 21:06 , Processed in 0.042222 second(s), 12 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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