文本型数值计算乘积

'Excel宏代码原创分享，转发请注明来源，作者：王欢为，WX：13772568903。

功能：求一至多个文本数字的乘积，并将乘积以文本形式返回。

特点：1．对参与计算的数字数目没有限制。

特点：2．数字支持正数、负数、整数、小数，不支持十进制阿拉伯数字以外的数字形式。

特点：3．结果为精确值，非近似值，不存在溢出现象。位数几乎无限（并非真正的无限）。

调用格式：
FFChengji("152648226598323268926598.256498",-2115793,0.29894)
可以文本数字和数值型数字混用，有几个数字输入几个数字，中间用逗号隔开。
上面表达式返回结果为：-96549264417486760284424296521.99656091116
如果乘数以逗号隔开，如：
FFChengji("152648226598323268926,598.256498", -2115793, 0.29894)
返回结果为：
-96,549,264,417,486,760,284,424,296,521.99656091116
如果乘数以空格隔开，如：
FFChengji("152648226598323268926 598.256498", -2115793, 0.29894)
返回结果为：
-9 6549 2644 1748 6760 2844 2429 6521.99656091116

 缺点：1．excel调用时，支持=FFChengji(A1,A2,A3,A4)的格式，但是不支持=FFChengji(A1:A4)的格式。

Function FFChengji(ParamArray Arr1()) As String
    'Excel宏代码原创分享，转发请注明来源，作者：王欢为，WX：13772568903。
    '此功能：对任意多个文本数字相乘求积，并将乘积以文本的形式返回。
    'Arr1函数的参数
    'Leny1是Arr1的下标最大值。
    'Str1依次取Arr1中的各个数字，
    'Str2取上一次相乘的乘积。
    'Str3用来存放本次相乘的乘积。
    'Len1在计算过程中取Str1的数字长度
    'Len2在计算过程中取Str2的数字长度
    'He1是计算过程中每一位相乘求积结果。
    'Jinwei1是计算过程中每一位相乘求积的进位。
    'Strfenduan1同一数字内部的分隔符，通常为逗号或空格。
    'Strfenduan2如果找到分隔符，记录该分隔符。
    'Weizhi1临时标记分隔符所在位置或相乘求积所在位置。
    'Fuhao1用来标记乘积的正负，1表示正数，-1表示负数
    'Xiaoshu1用来标记乘积的小数位数
    'StrJi1是一个全是0的字符串，长度等于Arr1各项长度之和。
    'StrJi2用来存放计算过程中的乘积。
    'ii,jj,kk用于循环。
    Dim Leny1&
    Leny1 = UBound(Arr1)
    If Leny1 = -1 Then '没有实参，返回""，然后退出。
        FFChengji = ""
        Exit Function
    ElseIf Leny1 = 0 Then '一个实参，返回该实参，然后退出。
        FFChengji = Arr1(0)
        Exit Function
    End If
    '两个或更多实参，下面进行相乘运算。
    Dim ii&, jj%, Strfenduan1$, Strfenduan2$, Weizhi1%, Fuhao1%, Xiaoshu1%
    Fuhao1 = 1
    Xiaoshu1 = 0
    Strfenduan1 = ", ，　"
    For ii = 0 To Leny1
        Arr1(ii) = "" & Arr1(ii) '将实参转换成文本格式。
        If Arr1(ii) = "" Then  '如果该实参为空，按“1”处理。
            Arr1(ii) = "1"
        Else '剔除Arr1中的正负号，小数点，分段符，使其变成整数形式。
            If Left(Arr1(ii), 1) = "-" Then
                Fuhao1 = -Fuhao1
                Arr1(ii) = Right(Arr1(ii), Len(Arr1(ii)) - 1)
            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
                Weizhi1 = InStr(1, Arr1(ii), ".")
                Xiaoshu1 = Xiaoshu1 + Len(Arr1(ii)) - Weizhi1
                Arr1(ii) = Left(Arr1(ii), Weizhi1 - 1) & Right(Arr1(ii), Len(Arr1(ii)) - Weizhi1)
            End If
        End If
    Next
    Dim Len1%, Len2%, Jinwei1%, He1%, Str1$, Str2$, Str3$, StrJi1$, StrJi2$
    len3 = 0
    For ii = 0 To Leny1
        len3 = len3 + Len(Arr1(ii))
    Next
    Str3 = Arr1(0)
    For ii = 1 To len3
        StrJi1 = StrJi1 & "0" 'StrJi1是一个全是0的字符串，长度等于Arr1各项长度之和。
    Next
    For ii = 1 To Leny1
        StrJi2 = StrJi1
        Str2 = Str3
        Str1 = Arr1(ii)
        Len1 = Len(Str1)
        Len2 = Len(Str2)
        For jj = Len1 To 1 Step -1
            Jinwei1 = 0
            Num1 = Val(Mid(Str1, jj, 1))
            For kk = Len2 To 1 Step -1
                Weizhi1 = Len1 - jj + Len2 - kk + 1
                He1 = Num1 * Val(Mid(Str2, kk, 1)) + Jinwei1 + Val(Left(Right(StrJi2, Weizhi1), 1))
                Jinwei1 = Int(He1 / 10)
                StrJi2 = Left(StrJi2, len3 - Weizhi1) & (He1 Mod 10) & Right(StrJi2, Weizhi1 - 1)
            Next
            Do While Jinwei1 > 0
                Weizhi1 = Len1 - jj + Len2 - kk + 1
                He1 = Jinwei1 + Val(Left(Right(StrJi2, Weizhi1), 1))
                Jinwei1 = Int(He1 / 10)
                StrJi2 = Left(StrJi2, len3 - Weizhi1) & (He1 Mod 10) & Right(StrJi2, Weizhi1 - 1)
            Loop
        Next
        For jj = 1 To len3
            Do While Left(StrJi2, 1) = "0"
                StrJi2 = Right(StrJi2, Len(StrJi2) - 1)
            Loop
            '删除乘积左侧多余的0，将结果赋值给Str3。
            If StrJi2 <> "" Then
                Str3 = StrJi2
                Exit For
            End If
            '如果某一次乘积为0，则直接返回0。
            FFChengji = 0
            Exit Function
        Next
    Next
    '为Str3插入分段符
    If Strfenduan2 = "," Or Strfenduan2 = "，" Then
        For ii = Len(Str3) - Xiaoshu1 - 3 To 1 Step -3
            Str3 = Left(Str3, ii) & "," & Right(Str3, Len(Str3) - ii)
        Next
    ElseIf Strfenduan2 = " " Or Strfenduan2 = "　" Then
        For ii = Len(Str3) - Xiaoshu1 - 4 To 1 Step -4
            Str3 = Left(Str3, ii) & " " & Right(Str3, Len(Str3) - ii)
        Next
    End If
    '为Str3插入小数点并删除小数部分右侧多余的0
    If Xiaoshu1 > 0 Then
        Str3 = Left(Str3, Len(Str3) - Xiaoshu1) & "." & Right(Str3, Xiaoshu1)
        For ii = 1 To Xiaoshu1
            If Right(Str3, 1) = "0" Then
               Str3 = Left(Str3, Len(Str3) - 1)
            Else
                Exit For
            End If
        Next
    End If
    '如果Str3是整数，删除小数点。
    If Right(Str3, 1) = "." Then
        Str3 = Left(Str3, Len(Str3) - 1)
    End If
    '如果str3是负数，插入"-"号
    If Fuhao1 = -1 Then
        Str3 = "-" & Str3
    End If
    FFChengji = Str3
End Function