本公式可查找 2~99999 之质数因子。
C1
=IF(PRODUCT($B1:B1)=$A1,"",MIN(IF($A1/PRODUCT(1,$B1:B1)/ROW($2:$99999)=INT($A1/PRODUCT(1,$B1:B1)/ROW($2:$99999)),ROW($2:$99999),9^9)))
数组公式 C+S+E 三键连按
右拉，下拉。

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

这个判断是否整除的方法真特别
谢谢分享

每天在牛*比的道路上，孤独的越走越远……

没看懂公式，但是公式中好像没看到开平方。
c=a1*a2的话，如果要查找整数 c 其中一个因数，只需要验证2到c^0.5之间的整数即可。
因为a1<c^0.5的整因数存在的话，必定存在a2>c^0.5
所以验证完2到c^0.5 ，如果没有因数，其实已经判定了它是质数。

我直接按照我思路写一个吧，肯定要开方的。C1数组公式：
=IF(PRODUCT($B1:B1)=$A1,"",IFERROR(MATCH(TRUE,$A1/MAX(1,PRODUCT($B1:B1))/INT($A1/MAX(1,PRODUCT($B1:B1))/ROW(INDIRECT("2:"&INT(($A1/MAX(1,PRODUCT($B1:B1)))^0.5))))=ROW(INDIRECT("2:"&INT(($A1/MAX(1,PRODUCT($B1:B1)))^0.5))),)+1,$A1/MAX(1,PRODUCT($B1:B1))))

.......改进 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

C1=IF(PRODUCT($B1:B1)=$A1,"",MIN(IF(MOD($A1/PRODUCT(1,$B1:B1),ROW($2:$1048576)),9^9,ROW($2:$1048576))))

人才

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

经过多日尝试，改进，写成以下代码，我的电脑跑 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