'Excel宏代码原创分享,转发请注明来源,作者:王欢为,WX:13772568903。
功能:对一至多个文本数字求和,并将和以文本形式返回。
特点:1.对参与计算的数字数目没有限制。
特点:2.数字支持正数、负数、整数、小数,不支持十进制阿拉伯数字以外的数字形式。
特点:3.结果为精确值,非近似值,不存在溢出现象。位数几乎无限(并非真正的无限)。
调用格式:
FFQiuhe("152648226598323268926598.256498",-2115793,0.29894)
可以文本数字和数值型数字混用,有几个数字输入几个数字,中间用逗号隔开。
上面表达式返回结果为:152648226598323266810805.555438
缺点:1.excel调用时,支持=FFQiuhe(A1,A2,A3,A4)的格式,但是不支持=FFQiuhe(A1:A4)的格式。
Function FFQiuhe(ParamArray Arr1()) As String
'Excel宏代码原创分享,转发请注明来源,作者:王欢为,WX:13772568903。
'此功能:对任意多个文本数字求和,并将和以文本的形式返回。
'Arr1函数的参数
'Leny1是Arr1的下标最大值。
'Lenx1
'Arr2将Arr1拆分成三部分,Arr2(ii,0)存放正负号,Arr2(ii,1)存放整数部分,Arr2(ii,2)存放小数部分。
'Arr3在求和过程中依次取所有的Arr2。
'Arr5在求和过程中存放每次求和的结果。
'Arr4在求和过程中依次取Arr5,并与Arr3求和。
'Len1在求和过程中取Arr3的数字长度
'Len2在求和过程中取Arr4的数字长度
'He1是求和过程中每一位求和结果,用于Arr5。
'Jinwei1是求和过程中每一位求和的进位,用于Arr5。
'Arr6是Arr5的备用选项。
'He2是求和过程中每一位求和结果,用于Arr6。
'Jinwei2是求和过程中每一位求和的进位,用于Arr6。
'Strfenduan1同一数字内部的分隔符,通常为逗号或空格。
'Strfenduan2如果找到分隔符,记录该分隔符。
'Weizhi1临时标记分隔符所在位置。
Dim Leny1&
Leny1 = UBound(Arr1)
If Leny1 = -1 Then '没有实参,返回“0”,然后退出。
FFQiuhe = "0"
Exit Function
ElseIf Leny1 = 0 Then '一个实参,返回该实参,然后退出。
FFQiuhe = Arr1(0)
Exit Function
End If
'两个或更多实参,下面进行求和。
Dim Arr2() As String 'Arr2()用来存放拆分后的实参。
ReDim Arr2(0 To Leny1, 0 To 2) As String
Dim ii&, jj%, Strfenduan1$, Strfenduan2$, Weizhi1%
Strfenduan1 = ", , "
For ii = 0 To Leny1
Arr1(ii) = "" & Arr1(ii) '将实参转换成文本格式。
If Arr1(ii) = "" Or Arr1(ii) = "0" Then '如果该实参为空,按“0”处理。
Arr2(ii, 0) = ""
Arr2(ii, 1) = "0"
Arr2(ii, 2) = ""
Else
If Left(Arr1(ii), 1) = "-" Then
Arr2(ii, 0) = "-" 'arr2(ii,0) 保存正负号
Arr1(ii) = Right(Arr1(ii), Len(Arr1(ii)) - 1)
Else
Arr2(ii, 0) = ""
End If
For jj = 1 To 4
Do While InStr(1, Arr1(ii), Mid(Strfenduan1, jj, 1)) > 0
Strfenduan2 = Mid(Strfenduan1, jj, 1)
Weizhi1 = InStr(1, Arr1(ii), Strfenduan2)
Arr1(ii) = Left(Arr1(ii), Weizhi1 - 1) & Right(Arr1(ii), Len(Arr1(ii)) - Weizhi1)
Loop
Next
If InStr(1, Arr1(ii), ".") > 0 Then
Arr2(ii, 1) = Left(Arr1(ii), InStr(1, Arr1(ii), ".") - 1) 'arr2(ii, 1) 保存整数部分
Arr2(ii, 2) = Right(Arr1(ii), Len(Arr1(ii)) - InStr(1, Arr1(ii), ".")) 'arr2(ii, 2) 保存小数部分
Else
Arr2(ii, 1) = Arr1(ii) 'arr2(ii, 1) 保存整数部分
Arr2(ii, 2) = "" 'arr2(ii, 2) 保存小数部分
End If
End If
Next
Dim Arr3(2) As String 'Arr3和Arr4进行求和,结果存放到Arr5。
Dim Arr4(2) As String
Dim Arr5(2) As String
Dim Arr6(1) As String
For jj = 0 To 2
Arr5(jj) = Arr2(0, jj)
Next
Dim Len1%, Len2%, Jinwei1%, Jinwei2%, He1%
For ii = 1 To Leny1
Jinwei1 = 0
Jinwei2 = 0
For jj = 0 To 2
Arr4(jj) = Arr5(jj)
Arr3(jj) = Arr2(ii, jj)
Next
'以下是从低到高逐位求和过程。
'以下对小数部分右侧补零对齐
Len1 = Len(Arr3(2))
Len2 = Len(Arr4(2))
If Len1 > Len2 Then
For jj = 1 To Len1 - Len2
Arr4(2) = Arr4(2) & "0"
Next
ElseIf Len1 < Len2 Then
For jj = 1 To Len2 - Len1
Arr3(2) = Arr3(2) & "0"
Next
End If
'以下对整数部分左侧补零对齐
Len1 = Len(Arr3(1))
Len2 = Len(Arr4(1))
If Len1 > Len2 Then
For jj = 1 To Len1 - Len2
Arr4(1) = "0" & Arr4(1)
Next
ElseIf Len1 < Len2 Then
For jj = 1 To Len2 - Len1
Arr3(1) = "0" & Arr3(1)
Next
End If
Arr3(1) = Arr3(1) & Arr3(2)
Arr4(1) = Arr4(1) & Arr4(2)
Len1 = Len(Arr3(1))
Len2 = Len(Arr3(2))
Arr5(0) = Arr3(0)
Arr5(1) = ""
Arr5(2) = ""
If Arr3(0) = Arr4(0) Then '同号相加
For jj = Len1 To 1 Step -1
He1 = Val(Mid(Arr3(1), jj, 1)) + Val(Mid(Arr4(1), jj, 1)) + Jinwei1
Jinwei1 = Fix(He1 / 10)
Arr5(1) = (He1 Mod 10) & Arr5(1)
Next
If Jinwei1 > 0 Then
Arr5(1) = Jinwei1 & Arr5(1)
End If
Else '异号相加
Arr6(0) = Arr4(0) 'str6只在一正一负时使用
Arr6(1) = ""
For jj = Len1 To 1 Step -1
He1 = 10 + Val(Mid(Arr3(1), jj, 1)) - Val(Mid(Arr4(1), jj, 1)) - Jinwei1
Jinwei1 = 1 - Fix(He1 / 10)
Arr5(1) = (He1 Mod 10) & Arr5(1)
He1 = 10 + Val(Mid(Arr4(1), jj, 1)) - Val(Mid(Arr3(1), jj, 1)) - Jinwei2
Jinwei2 = 1 - Fix(He1 / 10)
Arr6(1) = (He1 Mod 10) & Arr6(1)
Next
If Jinwei1 = 1 Then '如果Arr3-Arr4最高位不够, _
存在借位,则将最终结果换成Arr4-Arr3。
Arr5(0) = Arr6(0)
Arr5(1) = Arr6(1)
End If
End If
Arr5(2) = Right(Arr5(1), Len(Arr3(2)))
Arr5(1) = Left(Arr5(1), Len(Arr5(1)) - Len(Arr5(2)))
'以下删除整数部分左侧多余的0
If Len(Arr5(1)) > 1 Then
Do While Left(Arr5(1), 1) = "0"
If Len(Arr5(1)) <= 1 Then
Exit Do
End If
Arr5(1) = Right(Arr5(1), Len(Arr5(1)) - 1)
Loop
End If
Next
'以下删除小数部分右侧多余的0
If Len(Arr5(2)) > 1 Then
Do While Right(Arr5(2), 1) = "0"
Arr5(2) = Left(Arr5(2), Len(Arr5(2)) - 1)
Loop
End If
If Strfenduan2 = "," Or Strfenduan2 = "," Then
For ii = Len(Arr5(1)) - 3 To 1 Step -3
Arr5(1) = Left(Arr5(1), ii) & "," & Right(Arr5(1), Len(Arr5(1)) - ii)
Next
ElseIf Strfenduan2 = " " Or Strfenduan2 = " " Then
For ii = Len(Arr5(1)) - 4 To 1 Step -4
Arr5(1) = Left(Arr5(1), ii) & " " & Right(Arr5(1), Len(Arr5(1)) - ii)
Next
End If
If Len(Arr5(2)) > 1 Then
FFQiuhe = Arr5(0) & Arr5(1) & "." & Arr5(2)
Else
FFQiuhe = Arr5(0) & Arr5(1)
End If
If FFQiuhe = "-0" Then
FFQiuhe = "0"
End If
End Function