AW: Darts-Spiel-Tabelle
26.05.2025 12:53:08
MCO
Hallo Siegfried!
Du musst dies in jedes Tabellenmodul jeder Runde packen:
Private Sub Worksheet_Change(ByVal Target As Range)
Wurf_auswerten Target
End Sub
und das hier packst du in ein eigenes Modul, darauf wird jeweils zugegriffen
Sub Wurf_auswerten(geändert_rng As Range)
Dim wert_rng
Application.EnableEvents = False
Set wert_rng = Application.Intersect(geändert_rng, ActiveSheet.Range("E3,L3,S3,Z3"))
If Not wert_rng Is Nothing Then
Debug.Print wert_rng.Column,
'Wertprüfung
If geändert_rng > 180 Then MsgBox "Ungültige Eingabe!", vbExclamation, "Fehler": Target.Select: GoTo ende
If geändert_rng.Offset(1, 0) > "" Then
rest = geändert_rng.Offset(1, 0) - geändert_rng
Else
rest = Range("A1") - geändert_rng
End If
Set Wurfeintrag = geändert_rng.Offset(-1, -1).End(xlDown).Offset(1, 0)
Wurfeintrag.Value = geändert_rng
If rest 0 Then geändert_rng.Interior.ColorIndex = 44: MsgBox "Überworfen!", vbInformation: GoTo ende
geändert_rng.Offset(1, 0) = rest
If rest = 0 Then geändert_rng.Interior.Color = vbGreen: MsgBox "Gewonnen!", vbInformation: GoTo ende
If Int(rest / 111) = rest / 111 Then 'Schnapszahl!
'Spieler
spalte_sp = Round(wert_rng.Column / 6)
z_Pkt = WorksheetFunction.Match(rest, Range("AG:AG"), 0)
Range("AG1").Offset(z_Pkt - 1, spalte_sp) = 0.5
l_row = Range("AG1").End(xlDown).Row + 1
Range("AG1").Offset(l_row, spalte_sp) = geändert_rng.Offset(-2, -1).Value
End If
'auf nächstes Feld positioniern
Set new_Trgt = geändert_rng.Offset(0, 7)
If new_Trgt.Column 27 Then
new_Trgt.Select
Else
Range("E3").Select
End If
End If
ende:
Application.EnableEvents = True
End Sub
Aus deiner Aufstellung geht leider nicht hervor, wo die Geldbeträge eingetragen werden sollen, daher hab ichdas aus dem ursprünglichen Post mal herausgenommen.
Die Zuordnung der Namen musste ich aber unterhalb der Tabelle schreiben (sobald ein Wert eingetragen ist)
Auch die Werte einzelner Würfe wird jetzt mitgeschrieben.
(Die Ermittlung der Zufallszahl in deiner Funktion kann entfallen, ist bei mir enthalten)
Ich hoffe, du kommst damit weiter...
Gruß, MCO