|
Hallo zusammen,
ich habe in den letzten Tagen über den Worksheet_change-Trigger ein kleines Dartsspiel gebaut (also die Tabelle zum Eintragen, die Scheibe braucht man natürlich noch). Hierbei bin ich am überlegen, über eine Checkbox die Auswahlmöglichkeit von Double- bzw. Tripple-Out zu bauen. Da kommt mir natürlich der "Mod"-Befehl in den Sinn, nur komme ich aktuell nicht darauf, wie ich das in meine aktuelle Funktion integrieren kann.
Hier der bisherige Code:
Option Compare Text
Private del As Boolean
Private Sub worksheet_change(ByVal Target As Range)
With ThisWorkbook.Sheets("Darts")
If Not del Then 'Delete-Modus für Datenentfernung
If Target.Value = "DEL" Then 'Aktivierung des Delete-Modus durch eingabe von DEL
del = True 'Delete-Modus activated
Target.Value = ""
.Copy After:=Sheets(1)
Sheets(2).Name = "Game " & Format(Now(), "hh.nn, dd.mm.yyyy")
If Sheets.Count > 10 Then
Application.DisplayAlerts = False
Sheets(11).Delete
Application.DisplayAlerts = True
End If
.Activate
'Daten werden entfernt
.Range("A6:H" & .Rows.Count).Value = ""
.Range("B5").Value = ""
.Range("D5").Value = ""
.Range("F5").Value = ""
.Range("H5").Value = ""
.Range("B5").Select
del = False 'Delete-Modus deactivated
ElseIf Target.Value = "SCORE" Then
del = True
.Range("M2:M100").Value = ""
Target.Value = ""
del = False
Else 'Bei normaler Eingabe
If Target.row > 5 And Target.Column Mod 2 = 1 Then 'Wenn die Eingabe in einer passenden Spalte und _
Reihe getätigt wurde
Dim inte As Boolean 'Testet die Eingabe auf Integer-Tauglichkeit
Dim r As Integer, c As Integer, t As Integer, todo As Integer 'Eingaben
t = .Range("D1").Value 'Speichert den Wert für das Target (201, 301, 401, 501, etc.)
r = Target.row 'Speichert die aktuelle Zeile
c = Target.Column 'Speichert die aktuelle Spalte
On Error GoTo falsch 'Sollte es kein Integer-tauglicher Wert sein
Dim v As Integer 'Speichert den eingegebenen Wert
v = Target.Value 'Integer-Wert wird eingelesen
inte = True 'Sollte es bis hierhin durchlaufen ist der Wert integer-tauglich
If v >= 0 And v <= 60 Then 'Ist die Eingabe zwischen 0 und 60
If Target.row Mod 3 = 2 Then
If r = 8 Then
.Cells(r, c + 1).Value = t - .Cells(r - 2, c).Value - .Cells(r - 1, c).Value - .Cells(r, c).Value
.Cells(r - 1, c + 1).Value = (t - .Cells(r, c + 1).Value) / 3
Else
.Cells(r, c + 1).Value = .Cells(r - 3, c + 1).Value - .Cells(r - 2, c).Value - .Cells(r - 1, c).Value _
- .Cells(r, c).Value
.Cells(r - 1, c + 1).Value = (t - .Cells(r, c + 1).Value) / (r - 5)
If .Cells(r, c + 1).Value < 0 Then
MsgBox "Bust!"
todo = .Cells(r - 3, c + 1).Value
If todo - .Cells(r - 2, c).Value = 0 Then
.Cells(r - 1, c).Value = 0
.Cells(r, c).Value = 0
ElseIf todo - .Cells(r - 2, c).Value - .Cells(r - 1, c).Value = 0 Then
.Cells(r, c).Value = 0
ElseIf todo - .Cells(r, c).Value - .Cells(r - 1, c).Value - .Cells(r - 2, c).Value < 0 Then
.Cells(r - 2, c).Value = 0
.Cells(r - 1, c).Value = 0
.Cells(r, c).Value = 0
End If
ElseIf .Cells(r, c + 1).Value = 0 Then
MsgBox "Sieger: " & .Cells(5, c + 1).Value
Dim i As Integer
i = 2
While .Cells(i, 12).Value <> .Cells(5, c + 1).Value
i = i + 1
Wend
.Cells(i, 13).Value = .Cells(i, 13).Value + 1
.Cells(1, 6).Value = "DEL"
Exit Sub
End If
End If
.Cells(r - 2, c + 2).Select
r = r - 2
c = c + 2
If .Cells(5, c + 1) = "" Then
.Cells(r + 3, 1).Select
End If
End If
Else
MsgBox "Sie können keine so hohe Zahl werfen!"
Target.Select
End If
falsch:
If Not inte Then
MsgBox "Bitte geben Sie nur Ganzzahlen ein!"
Target.Select
End If
End If
End If
End If
End With
End Sub
Wenn ihr Ideen für die Umsetzung habt, wäre das eine große Hilfe.
|