Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

frage an chris wegen script

    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
      


    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
    



      


    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
    



      


    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ö


     

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