'nutze prim() aus http://www.rendar.de/excel/prim.txt
'berechne Würfel, fr den gilt:
'Summe über 5 Seiten ist ebenfalls PRIM

Sub test_wuerfel()
a = Cells(3, 1) '=0  <--- 3+a+delta ist Startprimzahl!
b = Cells(3, 2) '=0 oder =2
c = Cells(3, 3) '=0 oder =2
d = Cells(3, 4) '=0 oder =2
e = Cells(3, 5) '=0 oder =2
f = Cells(3, 6) '=0 oder =2
i = 5 'starte Ausgabe ab Zeile
max_abstand = Cells(3, 8) ' = 65 Abbruchkriterium
ende = Cells(3, 9) * 60 '= 20 Minuten
start = Timer

'Primzahlen
'Abstand
Do 'a
p1 = prim(3 + a)
Do 'b
p2 = prim(p1 + b)
d2 = p2 - p1
Do 'c
p3 = prim(p2 + c)
d3 = p3 - p2
Do 'd
p4 = prim(p3 + d)
d4 = p4 - p3
Do 'e
p5 = prim(p4 + e)
d5 = p5 - p4
Do 'f
p6 = prim(p5 + f)
d6 = p6 - p5

'Vereinfachung! Abkürzung?!
pmod = (p1 + p2 + p3 + p4 + p5 + p6) Mod 3
Application.StatusBar = p1 & " " & p2 & " " & p3 & " " & p4 & " " & p5 & " " & p6
If (pmod = 0 And a = 0) Or (pmod <> 0 And a <> 0) Then GoTo kurz

'Summen
s1 = p1 + p2 + p3 + p4 + p5
s2 = p1 + p2 + p3 + p4 + p6
s3 = p1 + p2 + p3 + p5 + p6
s4 = p1 + p2 + p4 + p5 + p6
s5 = p1 + p3 + p4 + p5 + p6
s6 = p2 + p3 + p4 + p5 + p6
Cells(1, 1) = s1
Cells(1, 2) = s2
Cells(1, 3) = s3
Cells(1, 4) = s4
Cells(1, 5) = s5
Cells(1, 6) = s6

'Testabstand
t1 = prim(Cells(1, 1)) - s1
t2 = prim(Cells(1, 2)) - s2
t3 = prim(Cells(1, 3)) - s3
t4 = prim(Cells(1, 4)) - s4
t5 = prim(Cells(1, 5)) - s5
t6 = prim(Cells(1, 6)) - s6

'Test
tges = t1 + t2 + t3 + t4 + t5 + t6

If tges = 0 Then
Cells(1 + i, 1) = p1
Cells(1 + i, 2) = p2
Cells(1 + i, 3) = p3
Cells(1 + i, 4) = p4
Cells(1 + i, 5) = p5
Cells(1 + i, 6) = p6
Cells(1 + i, 7) = CDate((Timer - start) / 86400)
'Rest bei Mod 3
Cells(2 + i, 1) = p1 Mod 3
Cells(2 + i, 2) = p2 Mod 3
Cells(2 + i, 3) = p3 Mod 3
Cells(2 + i, 4) = p4 Mod 3
Cells(2 + i, 5) = p5 Mod 3
Cells(2 + i, 6) = p6 Mod 3
i = i + 3
End If
kurz:
f = d6 + 2
If Timer > (ende + start) Then GoTo das_wars
Loop Until f > max_abstand
If f > max_abstand Then f = Cells(3, 6)
e = d5 + 2
Loop Until e > max_abstand
If e > max_abstand Then e = Cells(3, 5)
d = d4 + 2
Loop Until d > max_abstand
If d > max_abstand Then d = Cells(3, 4)
c = d3 + 2
Loop Until c > max_abstand
If c > max_abstand Then c = Cells(3, 3)
b = d2 + 2
Loop Until b > max_abstand
If b > max_abstand Then b = Cells(3, 2)
a = a + 2
Loop Until a > max_abstand
das_wars:

End Sub





Public Function prim(Optional sw As Long, Optional exi As Integer) As Long

If exi = CInt(0) Then exi = CInt(4)
If sw = CLng(0) Then sw = CLng(Rnd * 10 ^ exi)

Do
  gefunden = True
  prim = 0
  Select Case sw
    Case 1, 2, 3: prim = sw
    Case Is > 3:
            If sw Mod 2 = 1 Then
               i = 3
               wsw = CLng(Sqr(sw) + 1)
               Do
                 If sw Mod i = 0 Then
                    sw = sw + 2
                    gefunden = False
                 Else
                    i = i + 2
                 End If
               Loop Until Not gefunden Or i > wsw
               If gefunden Then prim = sw
            Else
               sw = sw + 1
               gefunden = False
            End If
  End Select
Loop Until gefunden
End Function
'mit=prim(Bezug+1) und kopierter Formel
'kann man eine ganze Primzahlenreihe erzeugen!
'z.B. A1=0 A2=prim(a1) A3=prim(a2+1) ...