大数阶乘的通用函数（不会溢出） 
--------------------------------------------------------------------------------
作者:周军  类别:VB技巧   日期:2002.09.11 08:39  今日/总浏览: 4/376 

 

一个通用函数，可计算任意大数的阶乘（不要太大哟），返回的是字符串。在我的 C2 1G,128MB SD,win98,vb6 环境下计算1000!，只用了4秒。
Text1用于显示结果，Text2用于输入要阶乘的数（比如1000），再按Command1就行了！ 
另有Label1、Label2、Label3可看到一些中间过程。 
这段还有点提速的余地，比如：用静态数组换掉动态数组，但录活性差多了。 
用这程序测速不错，看看我的测试 
1000! 4秒 
2000! 21秒 
3000! 59秒 
5000! 156秒 
不试了已有16330位数了，光输出结果就用去了4秒。 
对了，本来输入我是用循环：text1=text1 & cstr(result(i)) 方式的，一用吓了一跳，光1000!阶乘那2568位数就用了差不多一分钟才输完，看来字符串累加的方法千万要少用为妙。我这里的转换方法，大家可借鉴，至少在1000!时提速了一千倍！！！ 

Option Explicit 
Dim incl As Boolean, starttime As Long 
Private Function cacl(num As Long) As String 
Dim flag As Long, numlen As Long, last As Long 
Dim x As Long, k As Long, i As Long, m As Long, n As Long, j As Long 
Dim result() As Long, tmp1() As Long, tmp2() As Long, s() As String 
numlen = 1 
ReDim result(1 To numlen) 
result(1) = 1 
x = 0 
Do While incl = True And x < num 
   x = x + 1 
   flag = x 
   i = 0 
   Do 
       i = i + 1 
       last = flag Mod 10 '取出被乘数的最后一位 
       flag = flag \ 10   '去掉乘数的最后一位 
       tmp1 = result 
       n = 0 
       For k = 1 To numlen 
           m = tmp1(k) * last + n '用每一位数与上次结果数组中的每个数相乘并加上进位的数 
           tmp1(k) = m Mod 10     '取出最后一位并加入临时结果数组 
           n = m \ 10             '两个小于10的数相乘最多两位,这里取出进位数 
       Next 
       If n > 0 Then              '处理最后一个进位数 
           ReDim Preserve tmp1(1 To numlen + 1) 
           tmp1(numlen + 1) = n 
       End If 
       If i = 1 Then 
           tmp2 = tmp1  '用第二个临时数组保存每次个位数乘出来的结果 
       Else 
           n = 0        '下面把本次乘出来的临时数组与上次乘出来的临时结果错位相加（就象乘法算式一样）。 
           j = UBound(tmp1) + i - 1 
           If UBound(tmp2) < j Then ReDim Preserve tmp2(1 To j) 
           For k = i To j 
               m = tmp2(k) + tmp1(k - i + 1) + n 
               tmp2(k) = m Mod 10 
               n = m \ 10 
           Next 
           If n > 0 Then 
               ReDim Preserve tmp2(1 To j + 1) 
               tmp2(j + 1) = n 
           End If 
       End If 
   Loop While flag > 0 
   numlen = UBound(tmp2) 
   result = tmp2 
   Label1 = x     '下面三句可用Label1与Label2计算进度，并及时更新 
   Label2 = numlen 
   Label3 = Timer - starttime 
   DoEvents 
Loop 
k = UBound(result) 
ReDim s(1 To k) 
For i = k To 1 Step -1 
s(k - i + 1) = CStr(result(i)) 
Next 
cacl = Join(s, "") 
End Function 

Private Sub Command1_Click() 
Dim i As Long 
If incl = False Then 
Command1.Caption = "看看结果" 
incl = True 
starttime = Timer 
Text1 = cacl(CLng(Text2)) 
Else 
incl = False 
Command1.Caption = "再算一次" 
End If 
End Sub 
 

求大数阶乘的通用函数（二） 
--------------------------------------------------------------------------------
作者:周军  类别:VB技巧   日期:2004.06.03 16:18  今日/总浏览: 1/96 

 

求大数阶乘的通用函数是两年前写的一个函数，我总觉得，这个算法还有可优化的余地，于是，又重新做了点新尝试，不想大获成功，效率一下子又提高了10倍多，而且算法简单得惊人，故不敢独吞，赶紧贴出与大家共享。

Option Explicit
Private Function cacl(num As Long) As String
Dim numlen As Long, last As Long, x As Long
Dim i As Long, m As Long, n As Long
Dim result() As Long, starttime As Single
numlen = 1
starttime = Timer
ReDim result(1 To numlen)
result(1) = 1
x = 1
Do While x <= num
   last = 0
   For i = 1 To numlen
        m = result(i) * x + last
        result(i) = m Mod 10
        last = m \ 10
   Next
   If last > 0 Then
        n = Len(CStr(last))
        ReDim Preserve result(1 To numlen + n)
        For i = 1 To n
            result(numlen + i) = last Mod 10
            last = last \ 10
        Next
        numlen = UBound(result)
   End If
   x = x + 1
Loop
ReDim s(1 To numlen)
For i = 1 To numlen
s(i) = result(numlen + 1 - i)
Next
cacl = Join(s, "")
Debug.Print num & "！ ： 用时 "; Timer - starttime & " 秒, 结果 " & numlen & " 位"
End Function

Private Sub Command1_Click()
Dim i As Long
For i = 1 To 10
cacl i * 100
Next
'For i = 1 To 10
'cacl i * 1000
'Next
End Sub


输出结果：(C 2.4G,  256M DDR,WinXP,vb6 环境)

100！ ： 用时 0 秒, 结果 158 位
200！ ： 用时 1.171875E-02 秒, 结果 375 位
300！ ： 用时 3.515625E-02 秒, 结果 615 位
400！ ： 用时 4.296875E-02 秒, 结果 869 位
500！ ： 用时 8.203125E-02 秒, 结果 1135 位
600！ ： 用时 .1054688 秒, 结果 1409 位
700！ ： 用时 .15625 秒, 结果 1690 位
800！ ： 用时 .1992188 秒, 结果 1977 位
900！ ： 用时 .2617188 秒, 结果 2270 位
1000！ ： 用时 .3632813 秒, 结果 2568 位
2000！ ： 用时 1.53125 秒, 结果 5736 位
3000！ ： 用时 3.75 秒, 结果 9131 位
4000！ ： 用时 7.171875 秒, 结果 12674 位
5000！ ： 用时 11.45313 秒, 结果 16326 位
6000！ ： 用时 16.41016 秒, 结果 20066 位
7000！ ： 用时 22.83984 秒, 结果 23878 位
8000！ ： 用时 30.375 秒, 结果 27753 位
9000！ ： 用时 41.75 秒, 结果 31682 位
10000！ ： 用时 54.57813 秒, 结果 35660 位

这次输出慢了些，因为我在第一次测试10000！时，只用了47秒。不知会不会还有更快的算法。 

楼上太慢了，算法版已经讨论过这个问题了，详见：
http://community.csdn.net/Expert/xsl/Reply_Xml.asp?Topicid=3049738
还有另外几个帖子，现在找不到了

Dim base, s, tmps, i

base = 1
s = 1
tmps = 0

Do While s < 1000

  s = 1
  
  base = base + 1
  
  For i = 1 To base
  
    s = s * i
  
  Next
  
  tmps = s
   

   
Loop

MsgBox base - 1

Private Sub Command1_Click()
'MsgBox getn(1000 ^ 100)
MsgBox getn(1000)
End Sub
Function getn(ByVal max As Double) As Long
Dim i As Currency, temp As Double, logmax As Double
i = 0
temp = 0
logmax = Log(max)
Do While temp < logmax
i = i + 1
temp = temp + Log(i)
Loop
getn = i - 1
End Function

楼上说下原理，1000!应该LONG装不下的

转换成对数运算（乘法-->加法）：
Private Sub Command1_Click()
MsgBox getn(1000)
MsgBox getn("8.00E+10000000") ' the largest n where n!< 8*10^10000000
End Sub
Function getn(ByVal max As Variant) As Long
Dim i As Long, temp As Double, logmax As Double
i = 0
temp = 0
If Not InStr(max, "E+") > 0 Then max = Val(Left(max, 1)) & "E+" & Len(max) - 1
logmax = CDbl(Split(max, "E+")(1)) * Log(10) + Log(CDbl(Split(max, "E+")(0)))
Do While temp < logmax
i = i + 1
temp = temp + Log(i)
Loop
getn = i - 1
End Function

设置一个数组来存放结果，一个指针存放长度，然后采用k!=连续k-1个前面的结果累加！
int Compute(int result[],int *num,int k)
//关键代码
for(int i=0;i<*cp;i++)
{
  a[i]=2*b[i];//b[i]为暂存数组
  a[i+1]=a[i]/10;
}

//调整a[*cp]//因为有可能a[*cp]=2341;
//最后输出a[i]