利用上班时间做了一个本论坛题目：超大数字的阶乘问题，有成就感，散分100！

Question

http://expert.csdn.net/Expert/topic/1079/1079479.xmlPascal写的~~~

Answer 1

'*****************************************************************************
'  名  称: 高精度计算模块
'  作  用: 对整数进行高精度运算, 整数位数不限, 但进行很大数字运算时时间会很长
'  说  明: 所有运算过程(函数)的参数必须为开头不为"0"的只包含数字
'          的字符串 (不能是负数), 运算过程中不进行有效性检查
'*****************************************************************************Option Explicit
Option Base 1Private i As LongPublic Function HPC_Plus(HPC_a As String, HPC_b As String) As String
'*****************************************************************
'  名  称: 高精度加法运算函数
'  参数表: HPC_a As String       被加数
'          HPC_b As String       加数
'  返回值: HPC_Plus As String    和
'*****************************************************************
    Dim l As Long
    HPC_Length HPC_a, HPC_b, l
    Dim a() As Byte, b() As Byte
    ReDim a(l + 1), b(l)
    For i = 1 To l
        a(i) = CByte(Mid(HPC_a, l - i + 1, 1))
        b(i) = CByte(Mid(HPC_b, l - i + 1, 1))
    Next i
    For i = 1 To l
        a(i) = a(i) + b(i)
        If a(i) >= 10 Then
            a(i + 1) = a(i + 1) + 1
            a(i) = a(i) - 10
        End If
    Next i
    Dim Result As String
    For i = l + 1 To 1 Step -1
        Result = Result & CStr(a(i))
    Next i
    If Left(Result, 1) = "0" Then Result = Mid(Result, 2)
    HPC_Plus = Result
End FunctionPublic Function HPC_Minus(HPC_a As String, HPC_b As String) As String
'*****************************************************************
'  名  称: 高精度减法运算函数
'  参数表: HPC_a As String       被减数
'          HPC_b As String       减数
'  返回值: HPC_Plus As String    差
'*****************************************************************
    Dim l As Long, blnMinus As Boolean
    If HPC_a = HPC_b Then
        HPC_Minus = "0"
        Exit Function
    End If
    HPC_Length HPC_a, HPC_b, l
    blnMinus = Not (HPC_MatchLarge(HPC_a, HPC_b))
    If blnMinus Then Swap HPC_a, HPC_b
    Dim a() As Integer, b() As Integer
    ReDim a(l), b(l)
    For i = 1 To l
        a(i) = CInt(Mid(HPC_a, i, 1))
        b(i) = CInt(Mid(HPC_b, i, 1))
    Next i
    For i = l To 1 Step -1
        If a(i) >= b(i) Then
            a(i) = a(i) - b(i)
        Else
            a(i) = a(i) - b(i) + 10
            a(i - 1) = a(i - 1) - 1
        End If
    Next i
    Dim Result As String, s As Long
    For i = 1 To l
        Result = Result & CStr(a(i))
    Next i
    For i = 1 To l
        If Mid(Result, i, 1) <> "0" Then
            s = i
            Exit For
        End If
    Next i
    Result = Right(Result, l - s + 1)
    If blnMinus Then Result = "-" & Result
    HPC_Minus = Result
End FunctionPrivate Sub HPC_Length(HPC_a As String, HPC_b As String, l As Long)
'*****************************************************************
'  名  称: 高精度运算位数补齐过程
'  作  用: 使两个运算数位数相同
'  参数表: HPC_a As String       操作数1
'          HPC_b As String       操作数2
'             l as Long         补齐后位数
'*****************************************************************
    Dim la As Long, lb As Long
    la = Len(HPC_a): lb = Len(HPC_b)
    If la > lb Then
        HPC_b = String(la - lb, "0") & HPC_b
    ElseIf lb > la Then
        HPC_a = String(lb - la, "0") & HPC_a
    End If
    l = Len(HPC_a)
End SubPrivate Function HPC_MatchLarge(HPC_a As String, HPC_b As String) As Boolean
'*****************************************************************
'  名  称: 高精度运算比较大小函数
'  作  用: 比较两个运算数的大小
'  参数表: HPC_a As String               操作数1
'          HPC_b As String               操作数2
'  返回值: HPC_MatchLarge As Boolean     第一个数不小于第二个数时
'                                        为 True
'*****************************************************************
    If Len(HPC_a) > Len(HPC_b) Then
        HPC_MatchLarge = True
        Exit Function
    ElseIf Len(HPC_a) < Len(HPC_b) Then
        HPC_MatchLarge = False
        Exit Function
    End If
    Dim i As Long
    For i = 1 To Len(HPC_a)
        If Val(Mid(HPC_a, i, 1)) > Val(Mid(HPC_b, i, 1)) Then
            HPC_MatchLarge = True
            Exit Function
        ElseIf Val(Mid(HPC_a, i, 1)) < Val(Mid(HPC_b, i, 1)) Then
            HPC_MatchLarge = False
            Exit Function
        End If
    Next i
    HPC_MatchLarge = True
End FunctionPrivate Function HPC_MPSingle(HPC_SingleA As String, HPC_Single As Byte) As String
'*****************************************************************
'  名  称: 高精度运算多位数乘单位数模块(仅供中间调用)
'  作  用: 计算多位数乘单位数
'  参数表: HPC_SingleA As String         多位数
'          HPC_Single  As String         单位数
'  返回值: HPC_MPSingle As String        积
'  说  明: HPC_Single只可以是一位数
'*****************************************************************
    Dim ii As Integer, s As String, a() As Byte, c() As Byte
    ReDim a(0 To Len(HPC_SingleA)), c(Len(HPC_SingleA) + 1)
    For ii = 1 To Len(HPC_SingleA)
        a(ii) = CByte(Mid(HPC_SingleA, ii, 1))
    Next ii
    For ii = Len(HPC_SingleA) To 1 Step -1
        a(ii) = a(ii) * HPC_Single + c(ii + 1)
        If a(ii) >= 10 Then
            c(ii) = CByte(Left(LTrim(Str(a(ii))), 1))
            a(ii) = CByte(Right(Str(a(ii)), 1))
        End If
    Next ii
    a(0) = c(1)
    For ii = IIf(a(0) = 0, 1, 0) To Len(HPC_SingleA)
        s = s & LTrim(Str(a(ii)))
    Next ii
    HPC_MPSingle = s
End FunctionPublic Function HPC_MP(HPC_a As String, HPC_b As String) As String
'*****************************************************************
'  名  称: 高精度乘法运算函数
'  参数表: HPC_a As String           被乘数
'          HPC_b As String           乘数
'  返回值: HPC_MP As String          积
'  说  明: 本函数只能进行正整数乘法, 且当计算较大数时比较慢
'*****************************************************************
    Dim s As String, b() As Byte, ii As Long
    If Not (HPC_MatchLarge(HPC_a, HPC_b)) Then Swap HPC_a, HPC_b
    ReDim b(Len(HPC_b))
    For i = 1 To Len(HPC_b)
        b(i) = CByte(Mid(HPC_b, i, 1))
    Next i
    For ii = Len(HPC_b) To 1 Step -1
        s = HPC_Plus(s, HPC_MPSingle(HPC_a, b(ii)) & String(Len(HPC_b) - ii, "0"))
    Next ii
    HPC_MP = s
End FunctionPublic Function HPC_Factorial(HPC_n As String) As String
'******************************************************************
' 名    称: 高精度阶乘运算函数
' 作    用: 高精度计算阶乘
' 参 数 表: HPC_n         As String          阶乘底数
' 返 回 值: HPC_Factorial As String          非零为阶乘, 零为出错
'******************************************************************
    If HPC_n = "0" Then
        HPC_Factorial = "1"
        Exit Function
    End If
    If Left(HPC_n, 1) < "1" Or Left(HPC_n, 1) > "9" Then
        HPC_Factorial = "0"
        Exit Function
    End If
    Dim fa As String, ii As Long
    fa = HPC_n
    ii = 1
    Do While Not (HPC_MatchLarge(CStr(ii), HPC_n))
        fa = HPC_MP(fa, CStr(ii))
        ii = ii + 1
    Loop
    HPC_Factorial = fa
End FunctionPublic Sub Swap(a As Variant, b As Variant)
    Dim c As Variant
    c = a
    a = b
    b = c
End Sub用以上程序可以实现高精度（任意位数）加、减、乘、阶乘运算，速度比较慢

Answer 2

Tenner(Tenner) 你的例子是lang型的数据,精度照我的差远了，计算2万的阶乘你肯定要溢出出的！！

Answer 3

哈哈，没想到我的砖头引出不少玉来，起因是微软的一道智力题，问1000的阶乘最后一位不是0的数字是几，我自己做了一下，不过好像用不了5分钟，应该在两三秒钟。
Option Explicit
Private Function Factorial(intC As Integer) As String
On Error GoTo myErr:
    Dim intA() As Integer, intT() As Integer, i As Integer
    Dim j As Integer, intR As Integer
    ReDim intA(20), intT(20)
    If intC < 2 Then Exit Function
    intR = 20
    intA(0) = 1
    For i = 2 To intC
        For j = 0 To intR
            intT(j) = intA(j) * i
        Next j
        j = 0
        Do Until j > intR
            intA(j) = intT(j) Mod 10
            If intT(j) >= 10 Then intT(j + 1) = intT(j + 1) + intT(j) \ 10
            j = j + 1
        Loop
    Next i
    
    Do While True
        j = j - 1
        If intA(j) > 0 Then Exit Do
    Loop
    
    For j = j To 0 Step -1
        Factorial = Factorial & intA(j)
    Next j
    Exit Function
myErr:
    If Err.Number = 9 Then
        intR = intR + 20
        ReDim Preserve intA(intR)
        ReDim Preserve intT(intR)
        Resume
    Else
        MsgBox "UnKnow ERR:" & Err.Description & ":" & Err.Number, vbCritical + vbOKOnly
    End If
End FunctionPrivate Function f(intN As Integer) As StringDim result(8) As Long
Dim temp(8) As Long
Dim i As Integer
Dim j As Integerresult(0) = 1For i = 2 To intN    For j = 0 To 8
        temp(j) = i * result(j)
    Next j
    
    For j = 0 To 8
        result(j) = temp(j) Mod 10
        If temp(j) >= 10 Then
            If j < 8 Then temp(j + 1) = temp(j + 1) + temp(j) \ 10
        End If
    Next j
    
    Do While True
        If result(0) = 0 Then
            For j = 0 To 7
                result(j) = result(j + 1)
            Next j
            result(8) = 0
        Else
            Exit Do
        End If
    Loop
        
Next iFor i = 8 To 0 Step -1
    f = f & result(i)
Next i
End FunctionPrivate Sub Form_Load()
Debug.Print f(999)
Text1.Text = Factorial(999)
End Sub其中第一个函数显示所有的结果，第二个函数只显示最后8位不是0的数，就解决问题来说，第二个函数更快，但得不到所有结果，我还要感谢回答我问题的朋友westneverwin给了我思路。

Answer 4

我用C++写过一个，速度还可以不过比起MS的计算器还是差很多啊，该死的MS，唉