Придумал быстрый способ создать список простых чисел

ReDim PrCh&(u)

Option Explicit 
  
Dim Simp(4791) As Long 
Dim Mask(15014) As Byte 
Dim Out(15014) As Byte 
Dim Data(4095) As Long 
Dim nf As Long 
Public Max As Long 
Public fFile As Boolean 
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long) 
 
Sub Work() 
  Dim n As Long, i As Long 
  Dim k As Long, f As Boolean 
  Dim m As Long 
  Dim Base As Long 
 
  If fFile Then 
    nf = FreeFile 
    Open "out.bin" For Binary As #nf 
    Close #nf 
    Kill "out.bin" 
    Open "out.bin" For Binary As #nf 
    k = 2 
    Put #nf, , k 
  End If 
 
  k = 0 
  n = 3 
  While n <= 46349 
    m = Sqr(n) 
    f = False 
    For i = 2 To m 
      If (n Mod i) = 0 Then f = True: Exit For 
    Next i 
    If f = False Then 
      Simp(k) = n 
      k = k + 1 
    End If 
    n = n + 2 
  Wend 
 
  i = 0 
  For n = 0 To 15014 
    If n + n + 1 = Simp(i) Then 
      Out(n) = 0 
      i = i + 1 
    Else 
      Out(n) = 1 
    End If 
  Next n 
  If fFile Then SaveData 1 
 
  For i = 0 To 15014 
    Mask(i) = 0 
  Next i 
  For n = 0 To 4 
    For i = Simp(n) \ 2 To 15014 Step Simp(n) 
      Mask(i) = 1 
    Next i 
  Next n 
 
  For Base = 30030 To Max Step 30030 
    CopyMemory Out(0), Mask(0), 15015 
    n = 5: m = Sqr(Base + 30030) 
    Do 
      k = Simp(n) 
      If k > m Then Exit Do 
      i = k - (Base Mod k) 
      If i And 1 Then 
        i = i \ 2 
      Else 
        i = (i + k) \ 2 
      End If 
      While i < 15015 
        Out(i) = 1 
        i = i + k 
      Wend 
      n = n + 1 
    Loop 
    If fFile Then SaveData Base + 1 
  Next Base 
  If fFile Then 
    SaveData Base + 1 
    Close #nf 
  End If 
End Sub 
 
Sub SaveData(ByVal Base As Long) 
  Static i As Long 
  Dim n As Long 
  For n = 0 To 15014 
    If Out(n) = 0 Then 
      Data(i) = Base + n + n 
      i = i + 1 
      If i > 4095 Then 
        Put #nf, , Data() 
        i = 0 
      End If 
    End If 
  Next n 
End Sub

  k = 0 
  n = 3 
  While n <= 46349 
    m = Sqr(n) 
    f = False 
    For i = 2 To m 
      If (n Mod i) = 0 Then f = True: Exit For 
    Next i 
    If f = False Then 
      Simp(k) = n 
      k = k + 1 
    End If 
    n = n + 2 
  Wend