求某数的质数因子

.......改进 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&"] "),"--"))
数组公式，右拉，下拉。

.......改进 3
承蒙琉大侠指点，得以完满解决此题，郑重鸣谢琉大侠。
C1
=IF(B1=$A1,"是质数",IF(PRODUCT($B1:B1)=$A1,"",MIN(IF(ISNUMBER(-($A1/PRODUCT(1,$B1:B1)/ROW(INDIRECT("2:"& CEILING(($A1/PRODUCT(1,$B1:B1))^0.5,1)))&".1")),ROW(INDIRECT("2:"&CEILING(($A1/PRODUCT(1,$B1:B1))^0.5,1))),$A1/ PRODUCT(1,$B1:B1)))))

.......改进 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)))))
数组公式，右拉，下拉。

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

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

@杰西米特瓦利亚
很神奇
我用六筛法拼入埃拉托斯特尼筛法竟然20秒内完成。
只修改了排除部份。

排列一亿以内质数，共5,761,455个。
本程序使用 [ 六筛法 ] 及 [ 埃拉托斯特尼筛法 ] 混合，
如圖片顯示，只耗時12秒左右，速度比前进一大步。
Sub PrimeSearch()
ActiveSheet.UsedRange.Offset(0, 2).ClearContents
Application.EnableEvents = False
Application.Calculation = xlManual
Dim t1#, N&, i&, j&, ix%, row&, col%
t1 = Timer
N = 100000000
Dim arr%(1 To 100000000)
result_arr = Range("c1").Resize(80000, 100)
For i = 2 To 3
For j = i ^ 2 To N Step i
arr(j) = 1
Next j
Next i
For i = 6 To Int(Sqr(N)) Step 6
For ix = -1 To 1 Step 2
For j = (i + ix) ^ 2 To N Step i + ix
arr(j) = 1
Next j
Next ix
Next i
For i = 2 To N
If arr(i) = 0 Then
If Int(i / 1000000) > col Then col = col + 1: row = 0
row = row + 1
result_arr(row, col + 1) = i
End If
Next i
Range("c1").Resize(80000, 100).Value = result_arr
Cells(2, 1) = Timer - t1 & " s"
Application.Calculation = xlAutomatic
Application.EnableEvents = True
End Sub

增加2行，以堵塞六筛法的漏洞，我的电脑耗时少于12秒，如果电脑好可能在10秒以下。
增加:
If arr(i + ix) = 1 Then GoTo 888
888:

每天有改进，今天我的电脑跌穿10秒。
上层楼程序依图示增加 *2

Sub prime_test()
ActiveSheet.UsedRange.Offset(0, 2).ClearContents
Application.EnableEvents = False
Application.Calculation = xlManual
Dim t1#, n&, i&, j&, row&, col%
t1 = Timer
n = 100000000
Dim arr%(2 To 100000000)
Dim result_arr(1 To 80000, 1 To 100)
For i = 3 To Int(Sqr(n)) Step 2
If arr(i) <> 1 Then
For j = i * i To n Step i * 2
arr(j) = 1
Next j
End If
Next i
row = 1
result_arr(1, 1) = 2
For i = 3 To n Step 2
If arr(i) = 0 Then
If Int(i / 1000000) > col Then col = col + 1: row = 0
row = row + 1
result_arr(row, col + 1) = i
End If
Next i
Range("c1").Resize(80000, 100).Value = result_arr
Cells(2, 1) = Timer - t1
Application.Calculation = xlAutomatic
Application.EnableEvents = True
End Sub