excel吧 关注：280,095贴子：1,535,464
date
.......改进 2
进一步减少无用的运算，比上个公式大比率加快速度。
第 8，9，10行单行运算须时6秒，全10行一起运算20秒内完成。
本公式上限1,040,000，可能是row函数极限，没有深究。
C1
=IF(PRODUCT(1,$B1:B1)=$A1,"",IFERROR(--TEXT(MIN(IF(ISNUMBER(-($A1/PRODUCT(1,$B1:B1)/ROW(INDIRECT("2:"&MAX(2,INT($A1/PRODUCT(1,$B1:B1)))))&".1")),ROW(INDIRECT("2:"&MAX(2,INT($A1/PRODUCT(1,$B1:B1))) )),$A1)),"[="&$A1&"] "),"--"))
数组公式，右拉，下拉。
进一步减少无用的运算，比上个公式大比率加快速度。
第 8，9，10行单行运算须时6秒，全10行一起运算20秒内完成。
本公式上限1,040,000，可能是row函数极限，没有深究。
C1
=IF(PRODUCT(1,$B1:B1)=$A1,"",IFERROR(--TEXT(MIN(IF(ISNUMBER(-($A1/PRODUCT(1,$B1:B1)/ROW(INDIRECT("2:"&MAX(2,INT($A1/PRODUCT(1,$B1:B1)))))&".1")),ROW(INDIRECT("2:"&MAX(2,INT($A1/PRODUCT(1,$B1:B1))) )),$A1)),"[="&$A1&"] "),"--"))
数组公式，右拉，下拉。
.......改进 3.1
这公式没有突破12位数，运算方面除了先开个平方减少运算量之外，新增了撇开偶数，进一步减少运算量，速度上是11楼公式的一半。
C2
=IF(B2=$A2,"=质数",IF(PRODUCT($B2:B2)=$A2,"",IF(ISNUMBER(-($A2/PRODUCT(1,$B2:B2)/2&".1")),2,IFERROR(MATCH(1,--ISNUMBER(-($A2/PRODUCT(1,$B2:B2)/(ROW(INDIRECT("1:"&INT(($A2/PRODUCT(1,$B2:B2))^0.5/2+1)))*2+1)&".1")),)*2+1,$A2/PRODUCT(1,$B2:B2)))))
数组公式，右拉，下拉。
这公式没有突破12位数，运算方面除了先开个平方减少运算量之外，新增了撇开偶数，进一步减少运算量，速度上是11楼公式的一半。
C2
=IF(B2=$A2,"=质数",IF(PRODUCT($B2:B2)=$A2,"",IF(ISNUMBER(-($A2/PRODUCT(1,$B2:B2)/2&".1")),2,IFERROR(MATCH(1,--ISNUMBER(-($A2/PRODUCT(1,$B2:B2)/(ROW(INDIRECT("1:"&INT(($A2/PRODUCT(1,$B2:B2))^0.5/2+1)))*2+1)&".1")),)*2+1,$A2/PRODUCT(1,$B2:B2)))))
数组公式，右拉，下拉。
VBA 自订函数 -- 分解质因子
最大解 15位数，以上则无能为力。
继承13楼思路，除了开方也撇开偶数。
Function Factorize(ByVal src) As String
Dim num#, tnum#, i#, output$
num = src
If num < 2 Or num <> Int(num) Then
Factorize = "限>=2正整数": Exit Function
ElseIf num > 10 ^ 15 Then
Factorize = "限15位数以内": Exit Function
End If
Do While num / 2 = Int(num / 2)
num = num / 2
output = output & " * 2"
Loop
Dim loopend: loopend = Int(num ^ 0.5 + 1)
For i = 3 To loopend Step 2
encore:
tnum = num / i
If tnum = Int(tnum) Then
num = tnum
output = output & " * " & i
If i > num ^ 0.5 + 1 Then Exit For
GoTo encore
End If
Next
If num > 1 Then output = output & " * " & num
output = Mid(output, 4, 1000)
If output = src Then output = output & " =质数"
Factorize = output
End Function
最大解 15位数，以上则无能为力。
继承13楼思路，除了开方也撇开偶数。
Function Factorize(ByVal src) As String
Dim num#, tnum#, i#, output$
num = src
If num < 2 Or num <> Int(num) Then
Factorize = "限>=2正整数": Exit Function
ElseIf num > 10 ^ 15 Then
Factorize = "限15位数以内": Exit Function
End If
Do While num / 2 = Int(num / 2)
num = num / 2
output = output & " * 2"
Loop
Dim loopend: loopend = Int(num ^ 0.5 + 1)
For i = 3 To loopend Step 2
encore:
tnum = num / i
If tnum = Int(tnum) Then
num = tnum
output = output & " * " & i
If i > num ^ 0.5 + 1 Then Exit For
GoTo encore
End If
Next
If num > 1 Then output = output & " * " & num
output = Mid(output, 4, 1000)
If output = src Then output = output & " =质数"
Factorize = output
End Function
VBA ......排列一亿以内质数
由1至一亿之间质数共5,761,455个质数，旁证无误，百度知道可找到这句："一亿内有5761455个质数"。
这次用自己的计算机跑了1674秒，今天上午用别人的计算机跑640秒，似乎普通人的计算机很难列到1000万亿以内质数。
Sub prime_list()
Dim cols%, col%, n#, n_start#, n_end#, x#, j#, j_end#
Dim t1 As Double: Dim t2 As Double
t1 = Timer
cols = 100
Dim rng As Range: Set rng = Range("A3").Resize(78510, cols)
rng.ClearContents
Dim arr(): arr = rng
For col = 1 To cols
t2 = Timer
x = 3
n_start = (col - 1) * 10 ^ 6 + 1
n_end = col * 10 ^ 6
For n = n_start To n_end Step 2
j_end = Int(n ^ 0.5 + 1)
For j = 3 To j_end Step 2
If n / j = Int(n / j) Then GoTo nextloop
Next
x = x + 1
arr(x, col) = n
nextloop:
Next
arr(1, col) = Timer - t2
arr(2, col) = x - 3
Next
arr(4, 1) = 2
rng = arr
Range("a1") = Timer - t1
End Sub
由1至一亿之间质数共5,761,455个质数，旁证无误，百度知道可找到这句："一亿内有5761455个质数"。
这次用自己的计算机跑了1674秒，今天上午用别人的计算机跑640秒，似乎普通人的计算机很难列到1000万亿以内质数。
Sub prime_list()
Dim cols%, col%, n#, n_start#, n_end#, x#, j#, j_end#
Dim t1 As Double: Dim t2 As Double
t1 = Timer
cols = 100
Dim rng As Range: Set rng = Range("A3").Resize(78510, cols)
rng.ClearContents
Dim arr(): arr = rng
For col = 1 To cols
t2 = Timer
x = 3
n_start = (col - 1) * 10 ^ 6 + 1
n_end = col * 10 ^ 6
For n = n_start To n_end Step 2
j_end = Int(n ^ 0.5 + 1)
For j = 3 To j_end Step 2
If n / j = Int(n / j) Then GoTo nextloop
Next
x = x + 1
arr(x, col) = n
nextloop:
Next
arr(1, col) = Timer - t2
arr(2, col) = x - 3
Next
arr(4, 1) = 2
rng = arr
Range("a1") = Timer - t1
End Sub
经过多日尝试，改进，写成以下代码，我的电脑跑 275秒，
排列出一亿以内质数，共5,761,455个。
Sub primefinal()
Sheets("FINAL").Select
Dim rng As Range, arr()
Set rng = Range("b5").Resize(78500, 100)
arr = rng
Dim AP As Object: Set AP = Application
AP.EnableEvents = False
AP.Calculation = xlManual
Dim t1#, col%, r#
Dim num#, num_start#, num_end#, i#, i_end#
r = 2
For col = 1 To 100
t1 = Timer
num_start = (col - 1) * 10 ^ 6 + 1
num_end = col * 10 ^ 6
For num = num_start To num_end Step 2
If num Mod 3 = 0 Then GoTo noprime
i_end = Int(num ^ 0.5 + 1)
For i = 6 To i_end Step 6
If num Mod (i - 1) = 0 Then GoTo noprime
If num Mod (i + 1) = 0 Then GoTo noprime
Next i
'addprime
r = r + 1
arr(r, col) = num
noprime:
Next num
arr(1, col) = Timer - t1
r = 1
Next col
arr(2, 1) = 2
arr(3, 1) = 3
rng.Value = arr
AP.Calculation = xlAutomatic
AP.EnableEvents = True
End Sub
排列出一亿以内质数，共5,761,455个。
Sub primefinal()
Sheets("FINAL").Select
Dim rng As Range, arr()
Set rng = Range("b5").Resize(78500, 100)
arr = rng
Dim AP As Object: Set AP = Application
AP.EnableEvents = False
AP.Calculation = xlManual
Dim t1#, col%, r#
Dim num#, num_start#, num_end#, i#, i_end#
r = 2
For col = 1 To 100
t1 = Timer
num_start = (col - 1) * 10 ^ 6 + 1
num_end = col * 10 ^ 6
For num = num_start To num_end Step 2
If num Mod 3 = 0 Then GoTo noprime
i_end = Int(num ^ 0.5 + 1)
For i = 6 To i_end Step 6
If num Mod (i - 1) = 0 Then GoTo noprime
If num Mod (i + 1) = 0 Then GoTo noprime
Next i
'addprime
r = r + 1
arr(r, col) = num
noprime:
Next num
arr(1, col) = Timer - t1
r = 1
Next col
arr(2, 1) = 2
arr(3, 1) = 3
rng.Value = arr
AP.Calculation = xlAutomatic
AP.EnableEvents = True
End Sub
