Dart Liste Spieler Eintragen Verlierer fänt an

Hallo VBA User
Ich möchte eine Excel Tabelle mit VBA erstellen bei der ich im ersten Spiel per Textbox in einer Userform die Namen der Mitspieler eintrage. Das funktioniert auch perfekt.
Nachdem das Spiel gespielt worden ist, und ein Verlierer ermittelt ist, soll dann ein neues Spiel per Befehlsbutton gestartet werden.
Und hier komme ich zu meinem Problem.
Bei betätigen des Befehlsbuttons, sollen alle Spieler wieder in die Liste eingetragen werden, jedoch soll der Verlierer vorne an erster Position stehen und die Reihenfolge soll die gleiche bleiben (Verlierer fängt an und nicht erster, zweiter, dritter oder so)
Spieler Anzahl maximal 8 . Die Namen stehen in den Zeilen B2 bis I2 Und die Ergebnisse stehen dann in B27 bis I27. Alle Nichtverlierer haben am Schluss einen Punktestand von Null.
Nur der Verlierer behält Punkte übrig.
Wie kann man es hinbekommen, dass die Spieler Automatisch in alter Reihenfolge (Der Vordermann bleibt immer der gleiche) für das neue Spiel in B2 bis I2 eingetragen werden?
Und wenn es mal weniger Spieler sind, sollen die Namen natürlich auch immer in den vorderen Zellen stehen.
kann mir hierzu jemand helfen ?

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Ulli,
probier mal.

Sub newGame()
  Dim varPlayers As Variant, varNew() As Variant, varRet As Variant
  Dim lngCol As Long, lngIndex As Long
  With ActiveSheet
    If Application.CountA(.Range("B2:I2")) > 1 And Application.Max(.Range("B27:I27")) > 0 Then
      lngCol = Application.Max(2, .Cells(2, .Columns.Count).End(xlToLeft).Column)
      varPlayers = .Range(.Cells(2, 2), .Cells(2, lngCol))
      varRet = Application.Match(Application.Max(.Range("B27").Resize(1, lngCol - 1)), _
        .Range("B27").Resize(1, lngCol - 1), 0)
      If IsNumeric(varRet) Then
        If varRet > 1 Then
          Redim varNew(1 To 1, 1 To Ubound(varPlayers, 2))
          For lngIndex = 1 To Ubound(varPlayers, 2)
            varNew(1, lngIndex) = varPlayers(1, varRet)
            varRet = varRet + 1
            If varRet > Ubound(varPlayers, 2) Then varRet = 1
          Next
          .Range("B2").Resize(1, Ubound(varPlayers, 2)) = varNew
        End If
        .Range("B27:I27") = ""
      End If
    End If
  End With
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0

	A	B	C	D	E	F
1	Gruß Sepp
2
3

Beliebteste Forumthreads (12 Monate)

Dart Liste Spieler Eintragen Verlierer fänt an

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Dart Liste Spieler Eintragen Verlierer fänt an

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

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread