Moin Adde,
bevor ich lange Deinen Code analysiere (den du hier übrigens über das Format-Dropdown Normal auch leicht als solchen kennzeichnen kannst, womit er leichter lesbar wird) habe ich mal eben eine kleine Lösung gebastelt. Dazu baust Du Dir bitte eine einfache Tabelle mit folgenden Inhalten:
Zeile 1: Spalte C = Spieler A, Spalte E = 501, Spalte G = Spieler B
Zeile 2: B&F = Single, C&G = Double, D&H = Triple
Spalte E 3-22 die Werte 1 - 20, in die Zeile 23-25 die Wert 25, 50 und 0
Dann kopierst Du den folgenden Code in ein Arbeitsblatt und Rest übernimmt Deine Maus. Ab jetzt regiert der Doppelklick!
Ein Doppelklick in die Spalten B-D und F-H errechnet den Wert des Wurfs, und schreibt nach jedem dritten Wurf die Summe in die erste Zeile A & I. Dazu erscheint eine MessageBox, die du dann durch Deinen Code für das Schallereignis austauschen/ergänzen kannst.
Ein Doppelklick auf die 501 setzt alle Einträge wieder zurück. Du kannst ihn aber auch z.B. durch 301 ersetzen, falls Du diese Variante spielen willst.
Option Explicit
Public iDarts As Integer, iSum As Integer
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim iValue As Integer, rngLeft As Range, rngRight As Range
Cancel = True
'Range für die Werte pro Dart
Set rngLeft = Range("A3:A5")
Set rngRight = Range("I3:I5")
'Reset der aktuellen Spielwerte
If Target.Address = ("$E$1") Then
rngLeft.Clear
rngRight.Clear
Cells(1, 1).Clear
Cells(1, 9).Clear
End If
'Berechnung des Werts pro Dart je Spieler
Select Case Target.Row
Case 3 To 22
Select Case Target.Column
Case 2, 3, 4 'Spieler A
iDarts = iDarts + 1
iValue = (Cells(Target.Row, 5) * (Target.Column - 1))
iSum = iSum + iValue
Cells(iDarts + 2, 1) = iValue
Case 6, 7, 8 'Spieler B
iDarts = iDarts + 1
iValue = (Cells(Target.Row, 5) * (Target.Column - 5))
iSum = iSum + iValue
Cells(iDarts + 2, 9) = iValue
End Select
Case 23 To 25
Select Case Target.Column
Case 2, 3, 4
iDarts = iDarts + 1
iValue = Cells(Target.Row, 5)
iSum = iSum + iValue
Cells(iDarts + 2, 1) = iValue
Case 6, 7, 8
iDarts = iDarts + 1
iValue = Cells(Target.Row, 5)
iSum = iSum + iValue
Cells(iDarts + 2, 9) = iValue
End Select
End Select
'Abrechnung nach drei Darts, Reset der Public Integers
If iDarts = 3 Then
MsgBox iSum
'HIER GEHÖRT DER CODE ZUM AUFRUF DEINES SCHALLEREGNISSES HIN
Select Case Target.Column
Case 2, 3, 4
rngLeft.Clear
Cells(1, 1) = Cells(1, 1) + iSum
Case 6, 7, 8
rngRight.Clear
Cells(1, 9) = Cells(1, 9) + iSum
End Select
iDarts = 0
iSum = 0
End If
'Spielende
If Cells(1, 1) = Cells(1, 5) Or Cells(1, 9) = Cells(1, 5) Then
rngLeft.Clear
rngRight.Clear
Select Case Target.Column
Case 2, 3, 4
MsgBox "Spieler A hat gewonnen!", , "Game over!"
Case 6, 7, 8
MsgBox "Spieler B hat gewonnen!", , "Game over!"
End Select
End If
End Sub
Den Code kann man leicht noch so anpassen, dass Einträge immer nur bei einem Spieler möglich sind und durch Zellfarben der jeweilige Spieler markiert wird. Neben den Varianten 501 / 301 lässt sich auch z.B. Cricket realisieren. Das mache ich aber dann zuhause
Grüße
