Rangfolge erstellen...

Question

Hallo Forum, 

ich überarbeite gerade eine VB-Anwendung (Turnierverwaltung) in Visual Studio 2010.

Dabei existiert ein DataGrid, in dem die Ergebnisse eingetragen werden.

In der letzten Zeile soll die endgültige Platzierung stehen. Das wird derzeit aber nur anhand der Zeile Punkte: berechnet. 

Sollten die Punkte gleich sein, soll anschließend die Zeile Spiele: zur Berechnung der Punktgleichen herangezogen werden, danach die Zeile Sätze.

Sollten dann immer noch einige Spieler die gleichen Punkte haben, bleiben die auch vom Platz her gleich, ansonsten wird die Platzierung in einer Rangfolge ausgegeben.

In MS-Excel ist das mit der Funktion RANG ja kein Problem, aber in VB scheitere ich und bekomme das nicht hin.

Bisher wird im Code aus dem DataGrid die Zeile Punkte ausgelesen und in ein Array geschrieben und  anschließend eine Procedure aufgerufen, die das Ranking berechnet:

For X As Integer = 0 To 9
   With Me.gridGrp1
      If .Item(X + 1, 11).Value.ToString = "" Then .Item(X + 1, 11).Value = ""
      arrPkt(X) = .Item(X + 1, 11).Value.ToString
   End With
Next
Call Ranking(arrPkt, grp)

Sub Ranking(ByVal ArrWert() As String, ByVal grp As Integer)

Dim Zeile As Integer, Rang As Integer
Dim PosLst(0 To 9) As Integer, sTmp As String, iTmp As Integer
Dim flgSwap As Boolean

Zeile = 14

For i As Integer = 0 To UBound(PosLst) : PosLst(i) = i + 1 : Next i
   Do
    flgSwap = False
    For i = 0 To UBound(PosLst) - 1
      If Val(ArrWert(i)) < Val(ArrWert(i + 1)) Then
       sTmp = ArrWert(i) : ArrWert(i) = ArrWert(i + 1) : ArrWert(i + 1) = sTmp
       iTmp = PosLst(i) : PosLst(i) = PosLst(i + 1) : PosLst(i + 1) = iTmp
             flgSwap = True
        End If
           Next i
        Loop While flgSwap = True

        Rang = 1
        Select Case grp
            Case 0
                For i = 0 To UBound(PosLst)
                    If i > 0 Then
                        If Val(ArrWert(i - 1)) > Val(ArrWert(i)) Then Rang = Rang + 1
                    End If
                    gridGrp1.Item(PosLst(i), Zeile).Value = IIf(Val(ArrWert(i)) = 0 And gridGrp1.Item(PosLst(i), 12).Value.ToString = "", "", Rang)
                Next i

 .... code für weitere gruppen.....

        End Select

    End Sub

Da die ganze Anwendung schon recht alt ist und mehrfach in den Versionen des Studios konvertiert wurde, würde ich gerne diesen Bereich komplett umschreiben und eine vielleicht einfachere Ermittlung des Rankings hinbekommen.

Mir fehlt dazu aber leider im Moment der Durchblick und ich wäre für Anregungen sehr dankbar.

LG Micha

Answer 1

Hallo Micha,

Wenn Du bei gleicher Punktzahl nach den Spielen sortieren möchtest, wäre ein mögliches Verfahren die Übergabe eines zweiten Arrays (Spiele) als Parameter an die Funktion Ranking und die Anpassung der Bedingung. Das gleiche gilt auch für die letzte For-Schleife:

    Sub Ranking(ByVal ArrWert() As String, ByVal Spiele As Integer(), ByVal grp As Integer)

    Dim Zeile As Integer, Rang As Integer
    Dim PosLst(0 To 9) As Integer, sTmp As String, iTmp As Integer, spTemp As Integer
    Dim flgSwap As Boolean

    Zeile = 14

    For i As Integer = 0 To UBound(PosLst) : PosLst(i) = i + 1 : Next i
       Do
        flgSwap = False
        For i = 0 To UBound(PosLst) - 1
          If (Val(ArrWert(i)) < Val(ArrWert(i + 1))) OrElse (ArrWert(i) = ArrWert(i + 1) AndAlso Spiele(i) > Spiele(i + 1)) Then
           sTmp = ArrWert(i) : ArrWert(i) = ArrWert(i + 1) : ArrWert(i + 1) = sTmp
           iTmp = PosLst(i) : PosLst(i) = PosLst(i + 1) : PosLst(i + 1) = iTmp
           spTmp = Spiele(i) : Spiele(i) = Spiele(i + 1) : Spiele(i + 1) = spTmp
                 flgSwap = True
            End If
               Next i
            Loop While flgSwap = True

            Rang = 1
            Select Case grp
                Case 0
                    For i = 0 To UBound(PosLst)
                        If i > 0 Then
                            If (ArrWert(i - 1) > ArrWert(i)) OrElse ((ArrWert(i - 1) = ArrWert(i)) AndAlso (Spiele(i - 1) < Spiele(i))) Then
                            Rang = Rang + 1
                        End If
                        gridGrp1.Item(PosLst(i), Zeile).Value = IIf(Val(ArrWert(i)) = 0 And gridGrp1.Item(PosLst(i), 12).Value.ToString = "", "", Rang)
                    Next i
	    '...
            End Select
        End Sub

Analog geht es für die Sortierung nach Sätzen.

Gruß,
Dimitar

---

Bitte haben Sie Verständnis dafür, dass im Rahmen dieses Forums, welches auf dem Community-Prinzip „IT-Pros helfen IT-Pros“ beruht, kein technischer Support geleistet werden kann oder sonst welche garantierten Maßnahmen seitens Microsoft zugesichert werden können.

Answer 2

Hallo,

vielleicht wäre auch die Berechnung eines Scorewertes für jeden Spieler ein Ansatz.

Wie können die Spiele denn ausgehen, wie beim Fußball beliebig (23:11) oder in festen Grenzen wie beim Tennis (2 oder 3 Gewinnsätze)?

Gruß

Nachtrag: Alternatives Codebeispiel als Konsolen-Anwendung (ohne Berechnung von Scorewerten) ;-)

Module Module1
	Sub Main()
		Dim qrp As New List(Of Match)
		qrp.Add(New Match() With {.Name = "Brina",
			.Level1_Punkte = 4, .Level2_Spiele = 1, .Level3_Saetze = 1})
		qrp.Add(New Match() With {.Name = "Blondit",
			.Level1_Punkte = 3, .Level2_Spiele = 0, .Level3_Saetze = 1})
		qrp.Add(New Match() With {.Name = "Bimmel",
			.Level1_Punkte = 1, .Level2_Spiele = -2, .Level3_Saetze = -4})
		qrp.Add(New Match() With {.Name = "Angie",
			.Level1_Punkte = 4, .Level2_Spiele = 1, .Level3_Saetze = 2})
		qrp.Add(New Match() With {.Name = "Bommel",
			.Level1_Punkte = 4, .Level2_Spiele = 1, .Level3_Saetze = 2})

		Console.WriteLine("Quelle:")
		Console.WriteLine(New String("-"c, 80))
		For Each item In qrp
			Console.WriteLine(item.ToString)
		Next

		Dim qrpSortiert = Ranking(qrp)
		Console.WriteLine(New String("-"c, 80))
		Console.WriteLine("Ranking:")
		Console.WriteLine(New String("-"c, 80))
		For Each item In qrpSortiert
			Console.WriteLine(item.ToString)
		Next
		Console.ReadLine()

	End Sub

	Private Function Ranking(Games As List(Of Match)) As List(Of Match)
		Dim sorted = Games.OrderByDescending(Function(x1)
							 Return x1.Level1_Punkte
						 End Function).
						 ThenByDescending(Function(x2)
							Return x2.Level2_Spiele
						End Function).
						ThenByDescending(Function(x3)
							 Return x3.Level3_Saetze
						 End Function).ThenBy(Function(x4)
							Return x4.Name
						End Function).ToList()

		sorted(0).Rang = 1
		For i = 1 To sorted.Count - 1
			If sorted(i).Level1_Punkte <> sorted(i - 1).Level1_Punkte OrElse
					sorted(i).Level2_Spiele <> sorted(i - 1).Level2_Spiele OrElse
					sorted(i).Level3_Saetze <> sorted(i - 1).Level3_Saetze Then
				sorted(i).Rang = sorted(i - 1).Rang + 1
			Else
				sorted(i).Rang = sorted(i - 1).Rang
			End If
		Next
		Return sorted
	End Function

End Module
Public Class Match
	Public Name As String = ""
	Public Level1_Punkte As Integer
	Public Level2_Spiele As Integer
	Public Level3_Saetze As Integer
	Public Rang As Integer
	Public Overrides Function ToString() As String
		Return String.Format("Rang: {0} Name: {1} Punkte: {2} Spiele: {3} Sätze: {4} ", Rang, Name, Level1_Punkte, Level2_Spiele, Level3_Saetze)
	End Function
End Class

Answer 3

Hi Micha,
ich habe ,mal als Anregung ein Teil programmiert, wo Du sehen kannst, wie man den Platz berechnen kann. Kopiere den Code einfach in eine leere Form.

Public Class Form1
  Private dg As New DataGridView With {.Dock = DockStyle.Fill,
    .VirtualMode = True, .ReadOnly = True}
  Private gl As New Geschaeftslogik
  Private Sub Form25_Load(sender As Object, e As EventArgs) Handles MyBase.Load
    With dg
      .RowCount = gl.Ergebnisse.GetUpperBound(0)
      .ColumnCount = gl.Ergebnisse.GetUpperBound(1)
      AddHandler .CellValueNeeded, Sub(s As Object, ec As DataGridViewCellValueEventArgs)
                                     ec.Value = gl.Ergebnisse(ec.RowIndex, ec.ColumnIndex)
                                   End Sub
    End With
    Me.Controls.Add(dg)
  End Sub
End Class

Friend Class Geschaeftslogik
  Private Mannschaften As List(Of Mannschaft)
  Private Spiele As List(Of Spiel)
  Private Matrix(,) As String
  Public Sub New()
    Mannschaften = GetMannschaften()
    Spiele = GetSpiele()
    Matrix = GetMatrix
  End Sub

  Private Function GetMatrix() As String(,)
    Dim m(Mannschaften.Count + 6, Mannschaften.Count + 1) As String
    ' Beschriftungen darstellen
    For i = 0 To Mannschaften.Count - 1
      m(0, i + 1) = Mannschaften(i).Name ' Mannschaften oben
      m(i + 1, 0) = Mannschaften(i).Name ' Mannschaften links
    Next
    Dim zeileRes = Mannschaften.Count + 1
    m(zeileRes, 0) = "Punkte:"
    m(zeileRes + 1, 0) = "Spiele:"
    m(zeileRes + 2, 0) = "Sätze:"
    m(zeileRes + 3, 0) = "Platz:"
    ' Ergebnisse darstellen
    For i = 0 To Spiele.Count - 1
      m(Spiele(i).M1, Spiele(i).M2) = $"{Spiele(i).E1}:{Spiele(i).E2}"
      m(Spiele(i).M2, Spiele(i).M1) = $"{Spiele(i).E2}:{Spiele(i).E1}"
    Next
    ' Berechnungen
    Dim punkteListe As New List(Of RangHelper) ' für spätere Rang-Berechnung
    For i = 0 To Mannschaften.Count - 1
      ' Punkte berechnen
      m(zeileRes, i + 1) = 0 ' Rücksetzen
      For k = 0 To Spiele.Count - 1
        If Spiele(k).M1 = Mannschaften(i).ID Then
          Select Case True
            Case Spiele(k).E1 < Spiele(k).E2 : m(zeileRes, i + 1) += 2
            Case Spiele(k).E1 = Spiele(k).E2 : m(zeileRes, i + 1) += 1
          End Select
        End If
        If Spiele(k).M2 = Mannschaften(i).ID Then
          Select Case True
            Case Spiele(k).E1 > Spiele(k).E2 : m(zeileRes, i + 1) += 2
            Case Spiele(k).E1 = Spiele(k).E2 : m(zeileRes, i + 1) += 1
          End Select
        End If
      Next
      punkteListe.Add(New RangHelper With {.ID = i, .Punkte = m(zeileRes, i + 1)})
      ' Spiele

      ' Sätze

    Next
    ' Rang berechnen
    Dim rang As Integer = 0
    Dim rangPunkte As Integer = 0
    For Each helper In From item In punkteListe Order By item.Punkte Descending
      If helper.Punkte <> rangPunkte Then rang += 1
      rangPunkte = helper.Punkte
      m(zeileRes + 3, helper.ID + 1) = rang
    Next
    Return m
  End Function

  Friend ReadOnly Property Ergebnisse As String(,)
    Get
      Return Matrix
    End Get
  End Property

  Private Function GetMannschaften() As List(Of Mannschaft)
    Dim ms As New List(Of Mannschaft)
    ms.Add(New Mannschaft With {.ID = 1, .Name = "Brina"})
    ms.Add(New Mannschaft With {.ID = 2, .Name = "Blondit"})
    ms.Add(New Mannschaft With {.ID = 3, .Name = "Bimmel"})
    ms.Add(New Mannschaft With {.ID = 4, .Name = "Angie"})
    Return ms
  End Function

  Private Function GetSpiele() As List(Of Spiel)
    Dim sp As New List(Of Spiel)
    sp.Add(New Spiel With {.id = 1, .M1 = 2, .M2 = 1, .E1 = 1, .E2 = 0})
    sp.Add(New Spiel With {.id = 2, .M1 = 3, .M2 = 1, .E1 = 2, .E2 = 0})
    sp.Add(New Spiel With {.id = 3, .M1 = 4, .M2 = 1, .E1 = 0, .E2 = 2})
    sp.Add(New Spiel With {.id = 4, .M1 = 3, .M2 = 2, .E1 = 2, .E2 = 0})
    sp.Add(New Spiel With {.id = 5, .M1 = 4, .M2 = 2, .E1 = 1, .E2 = 1})
    sp.Add(New Spiel With {.id = 6, .M1 = 4, .M2 = 3, .E1 = 1, .E2 = 1})
    Return sp
  End Function
End Class

Friend Class Mannschaft
  Friend Property ID As Integer ' Nummer der Mannschaft
  Friend Property Name As String ' Name der Mannschaft
End Class

Friend Class Spiel
  Friend Property id As Integer ' Nummer des Spieles
  Friend Property M1 As Integer ' ID der ersten Mannschaft
  Friend Property M2 As Integer ' ID der 2. Mannschaft (Gegner)
  Friend Property E1 As Integer ' Ergebnis der ersten Mannschaft
  Friend Property E2 As Integer ' Ergebnis des Gegners
End Class

Friend Class RangHelper
  Friend Property ID As Integer ' Nummer der Mannschaft
  Friend Property Punkte As Integer ' Punkte der Mannschaft
End Class

---

--
Viele Grüsse
Peter Fleischer (ehem. MVP)
Meine Homepage mit Tipps und Tricks

Answer 4

Danke für die vielen nützlichen Hinweise. Ich habe die Prozedur Ranking nun soweit überarbeitet, dass es funktioniert, und dann zu spät die Lösung von P. Fleischer gesehen. Das sieht sehr gut aus und ich werde mich mal daran versuchen.

@ K. Pater: Die Spiele können nur in einem bestimmten Bereich Ergebnisse liefern. Folgende Werte sind möglich:

2:0, 0:2, 1:1 (eher selten auch 2:1, 1:2, ist abhängig vom Modus der gespielt wird.)

LG Micha