Autor: Peter Haserodt  --- Aus Excel VBA - Gruppe: Häufige Fragen

Zufallszahlen

Autor: Peter Haserodt - Erstellt: --      - Letzte Revision: --
Zufallszahlen kann man immer gebrauchen.

Zuerst ein Modul mit zwei Testaufrufen. 


' **************************************************************
'  Modul:  mdlZufallzahlen  Typ = Allgemeines Modul
' **************************************************************

Option Explicit
 
Public Sub Test_ZufallsZahlen_Direkt()
 On Error GoTo Fehler
 ZufallsZahlen Range("h2:h20"), 1, 49
 Exit Sub
 Fehler:
 MsgBox "Fehler: " & vbCrLf & Err.Description
End Sub
 
Public Sub Test_ZufallsZahlen_AusZellen()
 'benötigt in C2 den Bereich wie G10:G100
 ' in C3 die kleinste Zahl, in C4 die Größte Zahl
 ZufallsZahlen Range(Range("C2").Value), Range("C3").Value, _
 Range("C4").Value
 Exit Sub
 Fehler:
 MsgBox "Fehler: " & vbCrLf & Err.Description
End Sub
 
Private Sub ZufallsZahlen(Bereich As Range, ByVal Von As Long, _
 ByVal Bis As Long)
 ' #################################################
 ' Peter Haserodt 2004
 Dim vx() As Variant, i As Long, k As Integer
 On Error GoTo Fehler
 Randomize Timer
 With Bereich
  ReDim vx(.Rows.Count - 1)
  ReDim vx(.Rows.Count - 1, .Columns.Count - 1)
  For i = 1 To .Rows.Count
   For k = 1 To .Columns.Count
    vx(i - 1, k - 1) = Int((Bis - Von + 1) * Rnd + Von)
    
   Next k
  Next i
  .Value = vx()
 End With
 Exit Sub
 Fehler:
 MsgBox "Fehler: " & vbCrLf & Err.Description
End Sub
 
 ABCD
1    
2 ZufallsBereich:C10:G80 
3 Kleinste Zahl:3 
4 Größte Zahl:200 
5    
 

Als nächstes das ganze mit UserForm.
Die benötigten Steuerelemente sind im Code beschrieben. 


' **************************************************************
'  Modul:  frmZufallsZahlen  Typ = Userform
' **************************************************************

Option Explicit
' #################################################
'
' Peter Haserodt 2004
' Benötigte Steuerelemente:
' Commandbuttons: 2 Stück, Namen: cmdOK,cmdAbbrechen
' Textboxen: 2 Stück, Namen: txtMin, txtMax
' Ein RefEdit Name: refBereich
' Labels zum Beschriften
'
' #################################################
 
Private Sub cmdAbbrechen_Click()
 Unload Me
End Sub
 
Private Sub cmdOK_Click()
 ' Eine etwas bessere Fehlerbehandlung kann sich jeder selbst einbauen
 'Zum Beispiel ob in den Textboxen was drinsteht etc...
 On Error GoTo Fehler
 ZufallsZahlen Range(refBereich.Text), Val(txtMin), Val(txtMax)
 Unload Me
 Exit Sub
 Fehler:
 MsgBox "Fehler: " & vbCrLf & Err.Description
End Sub
 
Private Sub UserForm_Initialize()
 On Error Resume Next
 refBereich.Text = Selection.Address
End Sub
 
Private Sub ZufallsZahlen(Bereich As Range, ByVal Von As Long, _
 ByVal Bis As Long)
 Dim vx() As Variant, i As Long, k As Integer, iOldCalc As Variant
 On Error GoTo Fehler
 Randomize Timer
 With Bereich
  ReDim vx(.Rows.Count - 1)
  ReDim vx(.Rows.Count - 1, .Columns.Count - 1)
  For i = 1 To .Rows.Count
   For k = 1 To .Columns.Count
    vx(i - 1, k - 1) = Int((Bis - Von + 1) * Rnd + Von)
    
   Next k
  Next i
  .Value = vx()
 End With
 Exit Sub
 Fehler:
 MsgBox "Fehler: " & vbCrLf & Err.Description
End Sub



' **************************************************************
'  Modul:  mdlStartZufall  Typ = Allgemeines Modul
' **************************************************************

Option Explicit
 
Public Sub StartZufallsZahlen()
 frmZufallsZahlen.Show
End Sub

Weitere Artikel der Gruppe: Häufige Fragen Aus Excel VBA
Nach oben
ToDo
Google Werbung