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