Visual Basic for Applications/列出質數
.
此模組實現了埃拉託斯特尼篩法，用於列出質數。它旨在作為標準 VBA 模組在 Microsoft Excel 中執行。它在工作簿的 Sheet1 上列出在單位和某個引數整數值之間找到的質數，並使用訊息框進行短列表。.
- 對於此類過程，溢位是一個問題， 但只要輸入引數保持在幾百萬以內，溢位不太可能發生。
- 該方法雖然簡單，但速度相當慢， 因為即使要測試一個值，也必須完成所有倍數（2,3,5,7,...n）的序列。較大的輸入值需要幾分鐘才能完成。一種更快的辦法是隻測試小於輸入值平方根的因子；這種修改被用在 GetPrimeFactors() 過程中。
- 請注意，此過程將在每次列出之前清除 Sheet1 的任何內容。
- 維基共享資源中找到的一個動畫 GIF 包含在圖 1 中，以說明該方法。
- GetPrimeFactors() 及其實用程式DecMod() 列出給定整數的質因子。它是為十進位制子型別編寫的，因此它可以處理高達 28 位數字的輸入（假設全部是 9）。完成所需的時間差異很大，取決於找到的質數數量。有一個值得注意的特殊情況； 例如，輸入 23 個九時，答案需要很長時間，但對於 28 個九，則只需要大約 15 秒。其他值，如 20、21 和 22 個九等等，幾乎是瞬間完成的。在測試過程testGetPrimeFactors() 中使用字串作為輸入只是為了防止 Excel 截斷顯示的輸入整數，與使用的方法無關；這裡不是字串數學；只是一個十進位制子型別迴圈。
Option Explicit
Sub testListPrimes()
'Run this to list primes in range of
'unity to some integer value
Dim nNum As Long
'set upper limit of range here
'eg:1234567 gives 95360 primes from 2 to 1234547 in 3 minutes
nNum = 1234567
'MsgBox ListPrimes(nNum)
ListPrimes nNum
End Sub
Function ListPrimes(nInput As Long) As String
'Lists primes in range unity to nInput
'Output to Sheet1 and function name
'Method: Sieve of Eratosthenes
Dim arr() As Long, oSht As Worksheet, sOut As String
Dim a As Long, b As Long, c As Long, s As Long
Dim nRow As Long, nCol As Long
'dimension array
ReDim arr(1 To nInput)
'set reference to Sheet1
Set oSht = ThisWorkbook.Worksheets("Sheet1")
With oSht
.Activate
.Cells.ClearContents
End With
'fill work array with integers
If nInput > 1 Then
arr(1) = 0 'exception first element
For a = 2 To nInput
arr(a) = a
Next a
Else
MsgBox "Needs parameter greater than unity - closing"
Exit Function
End If
'Sieve of Eratosthenes
'progressively eliminate prime multiples
For b = 2 To nInput
DoEvents 'yield
If arr(b) <> 0 Then 'skip zeroed items
'replace prime multiples with zero
s = 2 * b
Do Until s > nInput
DoEvents 'yield
arr(s) = 0
s = s + b
Loop
End If
Next b
'Output of primes
sOut = "Primes in range 1 to " & nInput & ":" & vbCrLf
nRow = 1: nCol = 1
For c = 2 To nInput
If arr(c) <> 0 Then
oSht.Cells(nRow, nCol) = c 'primes list to Sheet1
nRow = nRow + 1
If c <> nInput Then 'and accumulate a string
sOut = sOut & c & ","
Else
sOut = sOut & c
End If
End If
Next c
ListPrimes = sOut
End Function
Sub testGetPrimeFactors()
'Run this for prime factors of integer
'Set integer as a string in sIn to avoid display truncation
'Decimal subtype applies and limited to 28 full digits.
Dim nIn, sIn As String, Reply, sOut As String, sT As String
'set integer to factorise here, as a string
sIn = "9999999999999999999999999999" '28 nines takes 15 seconds
nIn = CDec(sIn)
sOut = GetPrimeFactors(nIn)
MsgBox sOut & vbCrLf & _
"Input digits length : " & Len(sIn)
'optional inputbox allows copy of output
Reply = InputBox("Factors of" & nIn, , sOut)
End Sub
Function DecMod(Dividend As Variant, Divisor As Variant) As Variant
' Declare two double precision variables
Dim D1 As Variant, D2 As Variant
D1 = CDec(Dividend)
D2 = CDec(Divisor)
'return remainder after division
DecMod = D1 - (Int(D1 / D2) * D2)
End Function
Function GetPrimeFactors(ByVal nN As Variant) As String
'Returns prime factors of nN in parameter
'Maximum of 28 digits full digits for decimal subtype input.
'Completion times vary greatly - faster for more primes
'20,21,and 22 nines factorise immediately, 23 nines time excessive.
'25 nines in 6 seconds. Maximum input takes 15 seconds for 28 nines.
Dim nP As Variant, sAcc As String
nP = CDec(nP)
nP = 2
nN = CDec(nN)
sAcc = nN & " = "
'test successive factors
Do While nN >= nP * nP
DoEvents
If DecMod(nN, nP) = 0 Then
sAcc = sAcc & nP & " * "
nN = nN / nP '(divide by prime)
Else
nP = nP + 1
End If
Loop
'output results
GetPrimeFactors = sAcc & CStr(nN)
End Function