frage an chris wegen script

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: frage an chris wegen script
von: Markus
Geschrieben am: 07.10.2003 12:49:25

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
Bild


Betrifft: AW: frage an chris wegen script
von: ChrisL
Geschrieben am: 07.10.2003 13:51:29

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



Bild


Betrifft: AW: frage an chris wegen script
von: ChrisL
Geschrieben am: 08.10.2003 11:47:32

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



Bild


Betrifft: AW: frage an chris wegen script
von: Markus
Geschrieben am: 08.10.2003 18:14:08

1k dank! klappt supi..

(auch wenn ich absolut nich durchblicke)

hau rein.. man sieht sich..

tschö


 Bild

Beiträge aus den Excel-Beispielen zum Thema " frage an chris wegen script"