首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > 办公应用 > OFFICE教程 >

关于超长数目字的乘法计算的探讨(VBA千位以上的计算)

2011-12-26 
关于超长数字的乘法计算的探讨(VBA千位以上的计算)由于Excel的限制,其最大的有效计算位数只有12位左右,对

关于超长数字的乘法计算的探讨(VBA千位以上的计算)
由于Excel的限制,其最大的有效计算位数只有12位左右,对于100位以上的精确计算,Excel自带函数/公式已无法满足要求。
小弟在此发个计算方式,希望能抛砖引玉,望各路高手共同交流讨论。

VB code
Option Base 1Option Explicit'强行求2个数的精确乘积.Function SuperProduct(Value1, Value2) As String        'VTmp: 待用的Value储存值, VLen: Value的长度, VPoint: Value的小数点位置(0=无小数点).    Dim sVTmp1 As String, lVLen1 As Long, lVPoint1 As Long    Dim sVTmp2 As String, lVLen2 As Long, lVPoint2 As Long        'SuperProductN的小数点位置.    Dim lVPointT As Long        sVTmp1 = Trim$(Value1)    sVTmp2 = Trim$(Value2)        SuperProduct = "0"    '如果有错误,表明参数可能含有数组或对象.    If Err.Number <> 0 Then        Exit Function    ElseIf sVTmp1 = "" Or sVTmp2 = "" Or sVTmp1 = "0" Or sVTmp2 = "0" Then        Exit Function    End If        lVLen1 = Len(sVTmp1)    lVLen2 = Len(sVTmp2)        '定义各临时变量.    Dim i As Long, j As Long, lGroup1 As Long, lGroup2 As Long    Dim dArray1() As Double, dArray2() As Double    Dim dSuperArray() As Double    'SuperProduct的临时存储变量.    Dim sStmp As String        '获取Value的小数点位置.    lVPoint1 = 0    For i = 1 To lVLen1        If Mid$(sVTmp1, i, 1) = "." Then            lVPoint1 = i            Exit For        End If    Next i    lVPoint2 = 0    For i = 1 To lVLen1        If Mid$(sVTmp2, i, 1) = "." Then            lVPoint2 = i            Exit For        End If    Next i        '反馈SuperProduct的小数点位置.    If lVPoint1 + lVPoint2 > 0 Then        lVPointT = lVLen1 + lVLen2 - lVPoint1 - lVPoint2    Else        lVPointT = 0    End If        '将参数按整数处理,然后再在最终结果中插入小数点.    If lVPoint1 > 0 Then        sVTmp1 = Left$(sVTmp1, lVPoint1 - 1) & Right$(sVTmp1, lVLen1 - lVPoint1)    End If    If lVPoint2 > 0 Then        sVTmp2 = Left$(sVTmp2, lVPoint2 - 1) & Right$(sVTmp2, lVLen2 - lVPoint2)    End If        lVLen1 = Len(sVTmp1)    lVLen2 = Len(sVTmp2)        '将Value按4个数字一组分别计算,若分组不足4位的,用0补齐(前端补齐).    If lVLen1 Mod 4 > 0 Then        sVTmp1 = Right$("000" & sVTmp1, lVLen1 + 4 - lVLen1 Mod 4)    End If    If lVLen2 Mod 4 > 0 Then        sVTmp2 = Right$("000" & sVTmp2, lVLen2 + 4 - lVLen2 Mod 4)    End If        '将Value拆成Group组,并分别存如Array中;另外再定义用于临时存储结果片段的SuperArray.    lGroup1 = Len(sVTmp1) \ 4    lGroup2 = Len(sVTmp2) \ 4    ReDim dArray1(lGroup1)    ReDim dArray2(lGroup2)    ReDim dSuperArray(lGroup1 + lGroup2 - 1)        For i = 1 To lGroup1        dArray1(i) = CDbl(Mid(sVTmp1, 4 * i - 3, 4))    Next i    For i = 1 To lGroup2        dArray2(i) = CDbl(Mid(sVTmp2, 4 * i - 3, 4))    Next i        '对两个Array中的片段两两相乘,并将各片段的结果储存在SuperArray中.    For i = 1 To lGroup1        For j = 1 To lGroup2            dSuperArray(i + j - 1) = dArray1(i) * dArray2(j) + dSuperArray(i + j - 1)        Next j    Next i        '将SuperArray的各片段拼贴到sStmp中.    sStmp = ""    For i = lGroup1 + lGroup2 - 1 To 2 Step -1        sStmp = Right$("0000" & CStr(dSuperArray(i)), 4) & sStmp        dSuperArray(i - 1) = dSuperArray(i - 1) + CDbl(Left$("0000" & CStr(dSuperArray(i)), Len(CStr(dSuperArray(i)))))    Next i        sStmp = CStr(dSuperArray(1)) & sStmp        '补入小数点.    If lVPointT > 0 Then        SuperProduct = Left$(sStmp, Len(sStmp) - lVPointT) & "." & Right$(sStmp, lVPointT)    Else        SuperProduct = sStmp    End If        '释放内存.    sVTmp1 = ""    sVTmp2 = ""    sStmp = ""    Erase dArray1    Erase dArray2    Erase dSuperArray    End Function


小弟不才,发的算法有点慢,望大虾门指点。

[解决办法]
钻研精神可嘉
不过EXCEL里一般10位数的计算都很少的了
[解决办法]
高精度运算
------解决方案--------------------


小马拉大车

热点排行