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
转换成对数运算(乘法-->加法):
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
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
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