frage an chris wegen script

Forumthread: frage an chris wegen script

07.10.2003 12:49:25

Markus

Option Explicit


Sub Mischen()
Dim i As Byte, ii As Byte
On Error GoTo ErrorHandler:
Calculate
Application.Calculation = xlCalculationManual
For i = 1 To 3
For ii = 1 To 5
If Application.WorksheetFunction.Rank(Cells(ii, 5), Range("E1:E5")) = i Then
Cells(i, 2) = Cells(ii, 1)
Exit For
End If
Next ii
Next i
Range("C1") = Range("C1") + 1
Application.Calculation = xlCalculationAutomatic
ThisWorkbook.Save
Exit Sub
ErrorHandler:
MsgBox ("Fehler: Vermutlich sind nicht genügend Teilnehmer (min. 3) eingetragen.")
Application.Calculation = xlCalculationAutomatic
End Sub

____________________________________
jetzt meine frage, wie muß ich das umschreiben wenn aus den zellen B3:B7 drei leute in D3:D5 geschrieben werden sollen?

https://www.herber.de/forum/messages/318484.html

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: frage an chris wegen script

07.10.2003 13:51:29

ChrisL

Hi Markus

Habe nochmals umgeschrieben, jetzt kannst du auf die Hilfsspalte verzichten.

Gruss
Chris

Option Explicit


Sub Mischen()
Dim Anzahl As Byte, iCounter As Byte, i As Integer
Dim Zwi1, Zwi2
' Anzahl Namen ermitteln
Anzahl = 5 - Application.WorksheetFunction.CountBlank(Range("B3:B7"))
If Anzahl < 3 Then
MsgBox "Es braucht mindestens 3 Teilnehmer."
Exit Sub
End If
' Namen in Array einlesen
ReDim MyArray(0 To 1, 0 To Anzahl - 1) As Variant
For i = 3 To 7
If Cells(i, 2) <> "" Then
MyArray(0, iCounter) = Cells(i, 2)
MyArray(1, iCounter) = Rnd
iCounter = iCounter + 1
End If
Next i
' Array sortieren
For i = Anzahl To 2 Step -1
If MyArray(1, i - 1) < MyArray(1, i - 2) Then
Zwi1 = MyArray(0, i - 1)
Zwi2 = MyArray(1, 1 - 1)
MyArray(0, i - 1) = MyArray(0, i - 2)
MyArray(1, i - 1) = MyArray(1, i - 2)
MyArray(0, i - 2) = Zwi1
MyArray(1, i - 2) = Zwi2
End If
Next i
' Ergebnis Eintragen
For i = 1 To 3
Cells(i + 2, 4) = MyArray(0, i - 1)
Next i
' Zähler
Range("A1") = Range("A1") + 1
' Speichern
ThisWorkbook.Save
End Sub

AW: frage an chris wegen script

08.10.2003 11:47:32

ChrisL

Misch misch... so ist besser...

Option Explicit


Sub Mischen()
Dim Anzahl As Byte, i As Byte
Dim Zufall As Byte, ii As Integer
' Anzahl Namen ermitteln
Anzahl = 5 - Application.WorksheetFunction.CountBlank(Range("B3:B7"))
If Anzahl < 3 Then
MsgBox "Es braucht mindestens 3 Teilnehmer."
Exit Sub
End If
' Zufallszahlen in Array einlesen
ReDim MyArray(Anzahl - 1) As Variant
MyArray(0) = Int((Anzahl * Rnd) + 1)
For i = 1 To Anzahl - 1
Start:
Zufall = Int((Anzahl * Rnd) + 1)
For ii = 0 To Anzahl - 1
If MyArray(ii) = Zufall Then GoTo Start
Next ii
MyArray(i) = Zufall
Next i
' Ergebnis Namen in Tabelle eintragen
For i = 1 To 3
For ii = 0 To Anzahl - 1
If MyArray(ii) = i Then
Cells(i + 2, 4) = Cells(ii + 3, 2)
Exit For
End If
Next ii
Next i
' Zähler
Range("A1") = Range("A1") + 1
' Speichern
ThisWorkbook.Save
End Sub

AW: frage an chris wegen script

08.10.2003 18:14:08

Markus

1k dank! klappt supi..

(auch wenn ich absolut nich durchblicke)

hau rein.. man sieht sich..

tschö

Beliebteste Forumthreads (12 Monate)

Forumthread: frage an chris wegen script

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread