这是我做的，不过我觉得穷不尽所有的数，不知道哪位高手有更好的方法告诉我
本来不想贴出来，我希望只给个想法，但我发现有人曲解了我的想法
不能因为别人对我的想法的曲解而影响了本论坛的声誉，故发贴出来

Private Sub Command1_Click()
Dim i, j
Dim tf As Boolean
Dim fNum%
Dim MyArr()
Dim arrCun As Long
fNum = FreeFile
Open "C:\Test.txt" For Binary As fNum
'建立素数表（数组）
For i = 2 To Val(Text1)
Me.MousePointer = 11
tf = False
For j = 2 To i - 1
If i Mod j = 0 Then
DoEvents
tf = True
Exit For
End If
Next

If Not tf Then 'Put fNum, , CStr(i) & vbCrLf
arrCun = arrCun + 1
ReDim MyArr(arrCun)
MyArr(arrCun) = i
End If
Next
Dim mRes
'找出那些x=y*z形式的质数
For i = 1 To arrCun
For j = 1 To arrCun
DoEvents
mRes = MyArr(i) * MyArr(j)
If mRes > 99999999999999# Then Exit For
Put fNum, , CStr(mRes) & vbCrLf
Next
Next
Dim k
'找出那些x=y*z*k形式的质数
For i = 1 To arrCun
For j = 1 To arrCun
For k = 1 To arrCun
DoEvents
mRes = MyArr(i) * MyArr(j) * MyArr(k)
If mRes > 99999999999999# Then Exit For
Put fNum, , CStr(mRes) & vbCrLf
Next
Next
Next
Dim p
'找出那些x=y*z*k*p形式的质数
For i = 1 To arrCun
For j = 1 To arrCun
For k = 1 To arrCun
For p = 1 To arrCun
DoEvents
mRes = MyArr(i) * MyArr(j) * MyArr(k) * MyArr(p)
If mRes > 99999999999999# Then Exit For
Put fNum, , CStr(mRes) & vbCrLf
Next
Next
Next
Next
'找出那些x=y*z*k*p*q形式的质数
Dim q
For i = 1 To arrCun
For j = 1 To arrCun
For k = 1 To arrCun
For p = 1 To arrCun
For q = 1 To arrCun
DoEvents
mRes = MyArr(i) * MyArr(j) * MyArr(k) * MyArr(p) * MyArr(q)
If mRes > 99999999999999# Then Exit For
Put fNum, , CStr(mRes) & vbCrLf
Next
Next
Next
Next
Next
Close fNum
Me.MousePointer = 0

End Sub

[此贴子已经被作者于2007-4-29 13:15:32编辑过]

我没看到到你的帖子，接到你的信息后才找到你发的贴......