下面的算法在 http://www.csdn.net/develop/edit.asp?id=28308基础上改进，比其至少快10%：
sub calcfactorial(byval n as integer)
dim xys() as integer, x() as integer, y() as integer, result() as string, i as long, j as long, k as long, temp as long, stimer as double
if n < 0 then exit sub
redim x(1)
redim xys(1)
x(1) = 1
xys(1) = 1
k = 1
stimer = timer
do while k <= n
temp = len(cstr(k))
redim y(1 to temp)
for i = 1 to temp
y(i) = val(mid(k, temp + 1 - i, 1))
next
redim xys(1 to ubound(x) + ubound(y))
for i = 1 to ubound(x)
for j = 1 to ubound(y)
xys(i + j - 1) = xys(i + j - 1) + x(i) * y(j)
next
next
for i = 1 to ubound(x) + ubound(y) - 1
temp = xys(i) \ 10
xys(i) = xys(i) mod 10
xys(i + 1) = xys(i + 1) + temp
next
x = xys
if x(ubound(x)) = 0 then redim preserve x(1 to ubound(x) - 1)
k = k + 1
loop
redim result(1 to ubound(x))
for i = 1 to ubound(x)
result(i) = x(ubound(x) + 1 - i)
next
factorial = join(result, "")
debug.print k - 1 & "！ ： 用时 "; timer - stimer & " 秒, 结果 " & ubound(x) & " 位"
'debug.print factorial
erase x()
erase y()
erase xys()
erase result()
end sub
private sub command1_click()
for i = 1 to 9
calcfactorial i * 100
next
for i = 1 to 10
calcfactorial i * 100
next
end sub
结果输出：
100！ ： 用时 1.17187501018634e-05 秒, 结果 158 位
200！ ： 用时 3.10087890625255e-02 秒, 结果 375 位
300！ ： 用时 .1090087890625 秒, 结果 615 位
400！ ： 用时 .219002929687576 秒, 结果 869 位
500！ ： 用时 .344011718749925 秒, 结果 1135 位
600！ ： 用时 .547008789062602 秒, 结果 1409 位
700！ ： 用时 .75 秒, 结果 1690 位
800！ ： 用时 .9840087890625 秒, 结果 1977 位
900！ ： 用时 1.281005859375 秒, 结果 2270 位
1000！ ： 用时 1.59400292968758 秒, 结果 2568 位
2000！ ： 用时 8.36000292968743 秒, 结果 5736 位
3000！ ： 用时 20.4220146484374 秒, 结果 9131 位
4000！ ： 用时 38.1090146484376 秒, 结果 12674 位
5000！ ： 用时 61.6250058593751 秒, 结果 16326 位
6000！ ： 用时 91.1560175781251 秒, 结果 20066 位
7000！ ： 用时 126.781014648438 秒, 结果 23878 位
8000！ ： 用时 168.610005859375 秒, 结果 27753 位
9000！ ： 用时 216.530892578125 秒, 结果 31682 位
10000！ ： 用时 271.000017578125 秒, 结果 35660 位
