Option Explicit
 
Private Const cLongBits As Long = 32
Private Const cLongMaxIndex As Long = cLongBits - 1
 
Private pBits() As Long
Private pBitVal(0 To cLongMaxIndex) As Long
Private pBitValNot(0 To cLongMaxIndex) As Long
Private pCount As Long
Private i As Long
 
 
Private Sub Class_Initialize()
  pBitVal(0) = 1
  For i = 1 To cLongMaxIndex - 1
    pBitVal(i) = pBitVal(i - 1) * 2
  Next i
  pBitVal(cLongMaxIndex) = &H80000000
 
  For i = 0 To cLongMaxIndex
    pBitValNot(i) = Not pBitVal(i)
  Next i
 
  Bits = cLongBits
End Sub
 
Public Property Get Bits() As Long
  Bits = pCount
End Property
 
Public Property Let Bits( _
    ByVal Value As Long)
 
  pCount = Value
  i = (pCount - 1&) \ cLongBits
  ReDim Preserve pBits(0 To i)
End Property
 
Public Property Get Bit( _
      ByVal Index As Long) As Boolean
 
  Bit = CBool(pBits(Index \ cLongBits) And _
      pBitVal(Index And cLongMaxIndex))
End Property
 
Public Property Let Bit( _
    ByVal Index As Long, _
    ByVal Flag As Boolean)
 
  i = Index \ cLongBits
  If Flag Then
    pBits(i) = pBits(i) Or _
        pBitVal(Index And cLongMaxIndex)
  Else
    pBits(i) = pBits(i) And _
        pBitValNot(Index And cLongMaxIndex)
  End If
End Property
 
 
Public Sub Clear()
  i = (pCount - 1&) \ cLongBits
  ReDim pBits(0 To i)
End Sub
 
Public Property Get ToString() As String
  ToString = String$(pCount, "0")
  For i = 0 To pCount - 1
    If Bit(i) Then _
        Mid$(ToString, pCount - i, 1) = "1"
  Next i
End Property

Private Declare Function GetTickCount Lib "kernel32.dll" () As Long
 
Private Sub GetPrim()
Dim i As Long, bis As Long
Dim currentPrim As Long, viel As Long
Dim ColCount As Long
Dim intervallAnfang As Long
Dim ende As Long
Dim lstart As Long, lende As Long
Dim sOut As String
Dim bitPrim As clsBitArray
 
Set bitPrim = New clsBitArray
 
 
  bis = Text1.Text - 1
 
  lstart = GetTickCount
 
  bitPrim.Bits = bis
 
 
  currentPrim = 2
  ende = (bis + 1) / 2
  For currentPrim = 2 To ende
    viel = currentPrim + currentPrim 'Vielfache initialisieren
 
    If bitPrim.Bit(currentPrim) = False Then
      For i = currentPrim * 2 To bis Step currentPrim
        bitPrim.Bit(i) = True
 
      Next i
    End If
 
  Next currentPrim
 
  lende = GetTickCount
 
  sOut = "Dauer der Berechnung: " & lende - lstart & "ms" & vbCrLf
 
  MsgBox sOut
 
End Sub