sbRandInt (VBA)

Thu, 14 May 2026 01:46:00 +0100

Abstract

Falls Sie sich nicht oder lediglich begrenzt häufig wiederholende ganzzahlige Zufallszahlen zwischen zwei gegebenen Werten benötigen, dann empfehle ich, meine benutzerdefinierte Funktion sbRandInt zu verwenden:

Appendix – Programmcode sbRandInt

Bitte den Haftungsausschluss im Impressum beachten.

Function sbRandInt(ByVal lCount As Long, _
  lMin As Long, _
  lMax As Long, _
  Optional lRept As Long = 1) As Variant
'Returns lCount random integers between lMin and lMax, each one
'occurring zero to lRept times. lMax - lMin + 1 must be greater
'or equal to lCount.
'Error values:
'#NUM!   - lRept is less than 1
'#REF!   - lCount is greater than (lMax - lMin + 1) * lRept
'#VALUE! - lCount is less than 1
'Source (EN): http://www.sulprobil.de/sbrandint_en/
'Source (DE): http://www.berndplumhoff.de/sbrandint_de/
'(C) (P) by Bernd Plumhoff  30-Dec-2024 PB V1.02
Static bRandomized As Boolean
Dim i As Long, j As Long, k As Long
Dim lRnd As Long, lRange As Long
Const CLateInitFactor = 50

If lCount < 1 Then sbRandInt = CVErr(xlErrValue): Exit Function
If lRept < 1 Then sbRandInt = CVErr(xlErrNum): Exit Function
If lCount > (lMax - lMin + 1) * lRept Then sbRandInt = CVErr(xlErrRef): Exit Function

lRange = (lMax - lMin + 1) * lRept

ReDim lr(1 To lCount) As Long

If Not bRandomized Then Randomize: bRandomized = True

ReDim lT(1 To lRange) As Long
'If we have a huge range of possible random integers and a comparably
'small number of draws, i.e. if (lMax - lMin) * lRept >> lCount
'then we can save some runtime with late initialization.
If lRange / lCount < CLateInitFactor Then
  For i = 1 To lRange
    lT(i) = Int((i - 1) / lRept) + lMin
  Next i
End If

i = 1
If lRange / lCount < CLateInitFactor Then
  For k = 1 To UBound(lr)
    lRnd = Int(((lRange - i + 1) * Rnd) + 1)
    lr(k) = lT(lRnd)
    lT(lRnd) = lT(lRange - i + 1)
    i = i + 1
  Next k
Else
  j = lMin: If lMin <= 0 And lMax >= 0 Then j = 1
  For k = 1 To UBound(lr)
    lRnd = Int(((lRange - i + 1) * Rnd) + 1)
    If lT(lRnd) = 0 Then
      lr(k) = Int((lRnd - 1) / lRept) + j
    Else
      lr(k) = lT(lRnd)
    End If
    If lT(lRange - i + 1) = 0 Then
      lT(lRnd) = Int((lRange - i) / lRept) + j
    Else
      lT(lRnd) = lT(lRange - i + 1)
    End If
    i = i + 1
  Next k
  'If lRange includes zero we need to shift result array
  If lMin <= 0 And lMax >= 0 Then
    For k = 1 To UBound(lr)
      lr(k) = lr(k) + lMin - 1
    Next k
  End If
End If

sbRandInt = lr

End Function

Bitte den Haftungsausschluss im Impressum beachten.

Ganzzahlige Zufallszahlen on Bernd Plumhoff

sbRandInt (VBA)

Abstract

Appendix – Programmcode sbRandInt