'entwickelt von Winfried Radner
'mailto:Wolf.W.Radzinski@onlinehome.de
'Benutzung frei - ohne Gewähr

'entweder den Datenbereich selektieren und MISCHEN...


Sub mischen()
c = Selection.Columns.Count
r = Selection.Rows.Count
i = 0

Do
    i = i + 1
    ac = CLng(Fix(Rnd(1) * c))
    ar = CLng(Fix(Rnd(1) * r))
    temp = ActiveCell
    ActiveCell = ActiveCell.Offset(ar, ac)
    ActiveCell.Offset(ar, ac) = temp
    Loop Until i > (c * r)
End Sub


Sub mischenI()
Dim temp
c = Selection.Columns.Count
r = Selection.Rows.Count
acc = ActiveCell.Column
acr = ActiveCell.Row
i = 0

Do
    i = i + 1
    ac = CLng(Fix(Rnd(1) * c))
    ar = CLng(Fix(Rnd(1) * r))
    temp = Cells(acr, acc).Interior.ColorIndex
    Cells(acr, acc).Interior.ColorIndex = Cells(acr + ar, acc + ac).Interior.ColorIndex
    Cells(acr + ar, acc + ac).Interior.ColorIndex = temp
    Loop Until i > (c * r) * 1
End Sub


'oder folgenden Code verwenden ... (der MISCHT für n=k ebenfalls)
'geschrieben von Klaus Kühnlein
'mailto:klaus.kuehnlein@power.alstom.com

Sub Zufall()
  Dim n As Integer
  Dim k As Integer
  Dim i As Integer
  Dim j As Integer
  Dim l As Integer
  Dim b As Integer
  Dim a() As Integer
  Dim idx As Integer

  n = InputBox("Wieviele VVs?", "Anzahl", 1)
  Do
    k = InputBox("Wieviele Zahlen sollen erzeugt werden?" & Chr(10) _
                                & "maximal" & n, "Gewinne", 1)
  Loop While k > n
  ReDim a(n)
  [A:A].ClearContents
  [A1].Select
  For i = 1 To n
    a(i) = i
  Next i
  j = n
  For i = 1 To k
    idx = Int(Rnd * j) + 1
    Selection = a(idx)
    Selection.Offset(1, 0).Select
    For l = idx To j - 1
      a(l) = a(l + 1)
    Next l
    j = j - 1
  Next i
End Sub


'#################################
'#
'# neue Makros hinzugefügt 2003
'#
'#################################

'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+  (teilweise) entwickelt von Winfried Radner
'+  e-mail: Wolf.W.Radzinski@gmx.de
'+  Benutzung frei - ohne Gewähr
'+  14.1.2003 ---  http://www.rendar.de
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Sub ZufallMischenJeanie()
'Mischt die Zellen einer Selection
'kann auch für Auswahl von Zufallszahlen
'ohne zurücklegen verwendet werden!
'VBA Code von >>>Peter Haserodt<<<
'www.haserodt.de
Dim i As Long, anz As Long
Dim iTemp As Variant, iZ As Long

anz = Selection.Cells.Count

'beginne Zellen zu vertauschen
For i = anz To 1 Step -1
Randomize Timer
iZ = Int((i * Rnd) + 1)
iTemp = Selection.Item(iZ).Text
Selection.Item(iZ) = Selection.Item(i).Text
Selection.Item(i) = iTemp
Next i
End Sub

'folgender Code unterscheidet sich nur
'in der Methode der Zellauswahl
'und mischt etwas weniger "planvoll"
'd.h. im Durchschnitt bleiben ein paar
'Zellen mehr an ihrer Originalposition

Sub ZufallMischen1()
'Mischt die Zellen einer Selection
'kann auch für Auswahl von Zufallszahlen
'ohne zurücklegen verwendet werden!
'VBA Code von Winfried Radner
'www.rendar.de
Dim i As Long, anz As Long
Dim iTemp As Variant
Dim iA As Long, iB As Long

anz = Selection.Cells.Count

'beginne Zellen zu vertauschen
Randomize Timer
For i = 1 To anz
iA = Int((anz * Rnd) + 1)
iB = Int((anz * Rnd) + 1)
iTemp = Selection.Item(iA).Text
Selection.Item(iA) = Selection.Item(iB).Text
Selection.Item(iB) = iTemp
Next i
End Sub

Sub init_ZufallMischen()
Dim anz As Long
'wenn die Selection noch keine Daten enthält
'werden hiermit Defaultwerte initialisiert
'andernfalls muß dieser Codeteil nicht
'aufgerufen werden
anz = Selection.Cells.Count
For i = 1 To anz
Selection.Item(i) = i
Next i
End Sub

Sub testemischung()
Dim anz As Long
Dim quot As Double
'funktioniert nur mit Defaultzahlen!
anz = Selection.Cells.Count
quot = 0
For i = 1 To anz
  If Selection.Item(i) = i Then quot = quot + 1
Next i
quot = Int(quot / anz * 10000) / 100
MsgBox quot & "%"
End Sub