文本型数值求和

'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