分段输出到TXT文件，每段一亿。
改动GetPrime（） 中 For iA = 1 To 10 ， 把10改大可得到任意大的结果。
电脑是10年前的，没验证结果。
Option Explicit
Sub GetPrime()
Dim iA As Integer
Dim lMin As Long, lAll As Long
For iA = 1 To 10
lAll = 100000000 * iA
lMin = lAll - 100000000 + 1
If iA = 1 Then
Call Prime1_100Million
Else
Call PrimeToTxt(lMin, lAll)
End If
Next iA
End Sub
Sub PrimeToTxt(lMin As Long, lAll As Long)
Dim lL As Long
Dim TT
Dim arrA() As Long, arrSQR() As Long, arrAll() As Long
Dim arrResult(10000000)
Dim lN As Long, lA As Long, lB As Long
If lMin Mod 2 = 0 Then lMin = lMin + 1
TT = Timer
lN = Int(Sqr(lAll))
ReDim arrA(1 To lN)
'===Cycle 1/ Get Square array========
For lA = 2 To Int(Sqr(lN))
For lB = lA ^ 2 To lN Step lA
arrA(lB) = 1
lL = lL + 1
Next lB
Next lA
'---Get Array of Un-Mark---
lA = 0: lB = 0
For lA = 2 To lN
If arrA(lA) = 0 Then
lB = lB + 1
ReDim Preserve arrSQR(1 To lB)
arrSQR(lB) = lA
End If
lL = lL + 1
Next l
'===Cycle 2=================================
Dim lFirst As Long, lX As Long
ReDim arrAll(lMin To lAll)
For lA = 1 To UBound(arrSQR)
lFirst = 1
For lX = lMin To lAll
If lX Mod arrSQR(lA) = 0 Then
lFirst = lX
Exit For
End If
lL = lL + 1
Next lX
lB = 0
For lB = lFirst To lAll Step arrSQR(lA)
arrAll(lB) = 1
lL = lL + 1
Next lB
Next lA
lA = 0: lB = 1
For lA = lMin To lAll Step 2
If arrAll(lA) = 0 Then
arrResult(lB) = lA
lB = lB + 1
lL = lL + 1
End If
Next lA
'===Out put to Txt file===
Dim sA As String
Dim sName As String
sA = "Timer=" & Timer - TT & " "
sA = sA & "Cycle:=" & lL & " "
sA = sA & "Qty:=" & lB & " "
sA = sA & Trim(Join(arrResult, " "))
sName = ThisWorkbook.Path & "\" & "Prime_" & lMin & "_" & lAll & "_" & Format(Now, "hhmmss") & ".txt"
Call StrToTxt(sA, sName)
'===open txt file===
Dim WshShell As Object
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run sName, 1, 0
End Sub
Sub StrToTxt(sString As String, sFullName As String)
Dim arrA As Variant, iA As Integer
arrA = Split(sString, vbCr)
Open sFullName For Output As #1
For iA = 0 To UBound(arrA)
Print #1, arrA(iA)
Next
Close #1
End Sub
Sub Prime1_100Million()
Dim lL As Long
Dim TT
Dim arrA() As Long, arrSQR() As Long, arrAll() As Long
Dim arrResult(1 To 10000000) As String
Dim lAll As Long, lN As Long, lA As Long, lB As Long
TT = Timer
lAll = 100000000
ReDim arrAll(1 To lAll)
lN = Int(Sqr(lAll))
ReDim arrA(1 To lN)
'===Cycle 1/ Get Square array========
For lA = 2 To Int(Sqr(lN))
For lB = lA ^ 2 To lN Step lA
arrA(lB) = 1
lL = lL + 1
Next lB
Next lA
'---Get Array of Un-Mark---
lB = 0
For lA = 2 To lN
If arrA(lA) = 0 Then
lB = lB + 1
ReDim Preserve arrSQR(1 To lB)
arrSQR(lB) = lA
End If
lL = lL + 1
Next lA
'===Cycle 2===
For lA = 1 To UBound(arrSQR)
For lB = arrSQR(lA) ^ 2 To lAll Step arrSQR(lA) * 2
arrAll(lB) = 1
lL = lL + 1
Next lB
Next lA
lB = 1
For lA = 3 To lAll Step 2
If arrAll(lA) = 0 Then
arrResult(lB) = lA
lB = lB + 1
lL = lL + 1
End If
Next lA
'===Out put to Txt file===
Dim sA As String
Dim sName As String
sA = "Timer=" & Timer - TT & " "
sA = sA & "Cycle:=" & lL & " "
sA = sA & "Qty:=" & lB & " "
sA = sA & "2" & " "
sA = sA & Trim(Join(arrResult, " "))
sName = ThisWorkbook.Path & "\" & "Prime100Million_" & Format(Now, "hhmmss") & ".txt"
Call StrToTxt2(sA, sName)
'===open txt file===
Dim WshShell As Object
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run sName
End Sub
改动GetPrime（） 中 For iA = 1 To 10 ， 把10改大可得到任意大的结果。
电脑是10年前的，没验证结果。
Option Explicit
Sub GetPrime()
Dim iA As Integer
Dim lMin As Long, lAll As Long
For iA = 1 To 10
lAll = 100000000 * iA
lMin = lAll - 100000000 + 1
If iA = 1 Then
Call Prime1_100Million
Else
Call PrimeToTxt(lMin, lAll)
End If
Next iA
End Sub
Sub PrimeToTxt(lMin As Long, lAll As Long)
Dim lL As Long
Dim TT
Dim arrA() As Long, arrSQR() As Long, arrAll() As Long
Dim arrResult(10000000)
Dim lN As Long, lA As Long, lB As Long
If lMin Mod 2 = 0 Then lMin = lMin + 1
TT = Timer
lN = Int(Sqr(lAll))
ReDim arrA(1 To lN)
'===Cycle 1/ Get Square array========
For lA = 2 To Int(Sqr(lN))
For lB = lA ^ 2 To lN Step lA
arrA(lB) = 1
lL = lL + 1
Next lB
Next lA
'---Get Array of Un-Mark---
lA = 0: lB = 0
For lA = 2 To lN
If arrA(lA) = 0 Then
lB = lB + 1
ReDim Preserve arrSQR(1 To lB)
arrSQR(lB) = lA
End If
lL = lL + 1
Next l
'===Cycle 2=================================
Dim lFirst As Long, lX As Long
ReDim arrAll(lMin To lAll)
For lA = 1 To UBound(arrSQR)
lFirst = 1
For lX = lMin To lAll
If lX Mod arrSQR(lA) = 0 Then
lFirst = lX
Exit For
End If
lL = lL + 1
Next lX
lB = 0
For lB = lFirst To lAll Step arrSQR(lA)
arrAll(lB) = 1
lL = lL + 1
Next lB
Next lA
lA = 0: lB = 1
For lA = lMin To lAll Step 2
If arrAll(lA) = 0 Then
arrResult(lB) = lA
lB = lB + 1
lL = lL + 1
End If
Next lA
'===Out put to Txt file===
Dim sA As String
Dim sName As String
sA = "Timer=" & Timer - TT & " "
sA = sA & "Cycle:=" & lL & " "
sA = sA & "Qty:=" & lB & " "
sA = sA & Trim(Join(arrResult, " "))
sName = ThisWorkbook.Path & "\" & "Prime_" & lMin & "_" & lAll & "_" & Format(Now, "hhmmss") & ".txt"
Call StrToTxt(sA, sName)
'===open txt file===
Dim WshShell As Object
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run sName, 1, 0
End Sub
Sub StrToTxt(sString As String, sFullName As String)
Dim arrA As Variant, iA As Integer
arrA = Split(sString, vbCr)
Open sFullName For Output As #1
For iA = 0 To UBound(arrA)
Print #1, arrA(iA)
Next
Close #1
End Sub
Sub Prime1_100Million()
Dim lL As Long
Dim TT
Dim arrA() As Long, arrSQR() As Long, arrAll() As Long
Dim arrResult(1 To 10000000) As String
Dim lAll As Long, lN As Long, lA As Long, lB As Long
TT = Timer
lAll = 100000000
ReDim arrAll(1 To lAll)
lN = Int(Sqr(lAll))
ReDim arrA(1 To lN)
'===Cycle 1/ Get Square array========
For lA = 2 To Int(Sqr(lN))
For lB = lA ^ 2 To lN Step lA
arrA(lB) = 1
lL = lL + 1
Next lB
Next lA
'---Get Array of Un-Mark---
lB = 0
For lA = 2 To lN
If arrA(lA) = 0 Then
lB = lB + 1
ReDim Preserve arrSQR(1 To lB)
arrSQR(lB) = lA
End If
lL = lL + 1
Next lA
'===Cycle 2===
For lA = 1 To UBound(arrSQR)
For lB = arrSQR(lA) ^ 2 To lAll Step arrSQR(lA) * 2
arrAll(lB) = 1
lL = lL + 1
Next lB
Next lA
lB = 1
For lA = 3 To lAll Step 2
If arrAll(lA) = 0 Then
arrResult(lB) = lA
lB = lB + 1
lL = lL + 1
End If
Next lA
'===Out put to Txt file===
Dim sA As String
Dim sName As String
sA = "Timer=" & Timer - TT & " "
sA = sA & "Cycle:=" & lL & " "
sA = sA & "Qty:=" & lB & " "
sA = sA & "2" & " "
sA = sA & Trim(Join(arrResult, " "))
sName = ThisWorkbook.Path & "\" & "Prime100Million_" & Format(Now, "hhmmss") & ".txt"
Call StrToTxt2(sA, sName)
'===open txt file===
Dim WshShell As Object
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run sName
End Sub
菠萝蜜
