AW: Rückfrage
04.10.2009 19:38:41
alifa
Sub SummeVierIstPrimzahl()
Dim i As Long, u As Double, lngR As Long
Dim n As Byte, k As Byte, j As Byte
Dim vSrc, t!
t = Timer
'Einträge:
vSrc = Array(1296, 1225, 1296, 1369, 1444, 1521, 1600, 1681, 1764, 1849, _
1936, 2025, 2116, 2209, 2304, 2401, 2500, 26012704, 2809, 2916, 3025, 3136, _
3249, 3364, 3481, 3600, 3721, 3844, 3969)
k = 4
n = UBound(vSrc) + 1
If k > n Then MsgBox "k > n", 16: Exit Sub
With Application
u = .Fact(n) / (.Fact(k) * .Fact(n - k))
End With
If u > Rows.Count Then MsgBox u & " > " & Rows.Count, 16: Exit Sub
ReDim vRes(k - 1)
ReDim bPos(k - 1) As Byte
For i = 1 To k
bPos(i - 1) = i
Next
Application.ScreenUpdating = False
With ActiveSheet
.Cells.Delete
For i = 1 To u
lngR = lngR + 1
For j = 0 To UBound(bPos)
vRes(j) = vSrc(bPos(j) - 1)
Next
.Range(.Cells(lngR, 1), .Cells(lngR, k)).Value = vRes
Call GetComb(n, k, bPos)
Next
End With
Application.ScreenUpdating = True
MsgBox "fertig in " & Round(Timer - t, 2) & " Sek "
End Sub
Sub GetComb(ByVal n As Byte, ByVal k As Byte, bPos() As Byte)
Dim i As Byte, j As Byte
i = k - 1
Do While bPos(i) >= n - k + i + 1
If i = 0 Then Exit Do
i = i - 1
Loop
bPos(i) = bPos(i) + 1
For j = i To k - 1
bPos(j) = bPos(i) + j - i
Next
End Sub
Es sollen aber nur DIE Kombinationen in die Tabelle geschrieben werden, deren Summe eine Primzahl ergibt.Z.B.1849+2116+2401+3025=9391