Zelle soll Inhalt behalten wenn Bedingung erfüllt ist

Question

Hallo und guten Morgen / Tag

habe erst gesucht ob eventuell eine Lösung für mein Problem gibt, habe aber leider nichts gefunden, das meinem Thema helfen könnte.

Daher habe ich erst die Frage gestellt.

Versuche verzweifelt nach einer Formel für Dart Doppel in anstatt Doppel out zu erstellen, doch was ich probiere schlug fehl.

Vielleicht kann mir jemand helfen?

Folgendes möchte ich gerne erreichen.

Bei dem Doppel In werden erst die Punkte Addiert, wenn ich ein Doppel mit einem von DREI Dart`s treffe, sonst bleiben die Zellen mit einer 0 Bzw. leer belegt, das bleibt solange bis ich einmal getroffen habe, danach sollen alle Werte der Treffer addiert werden.

Habe Zellen auf die ich mit einem Doppelklick ein Doppel in eine bestimmte Zelle übernommen wird.

Beispiel in den Zellen IL2 bis IL11 und IO2 bis IO12 und in IM12 sind die Werte für das Doppel.

Treffe ich ein Doppel, wird dies mit einem JA in der dafür vorgesehene Zelle ein getragen.

Sollte ich mit den ersten 3 Würfe irgendein Doppel treffen ist das Super und für die folgenden Würfe werden addiert. Dies gilt für alle Spieler.

Sollte ich widererwarten erst nach dem 7 Wurf treffen, sollte erst ab diesem Zeitpunkt die Addition stattfinden.

Mit dieser Formel klappt es nur so lange ich ein Doppel treffe.

Beispiel: Treffe mit den ersten 3 Pfeile nicht in ein Doppel bleibt es 0 Punkte, ist auch richtig.

Mit dem 4 Wurf treffe ich in ein Doppel wird die Zahl übernommen. So soll es auch sein, aber sobald ich eine andere Zahl  (kein Doppel) nach diesem Wurf anklicke wird alles auf null oder leer ersetzt, da in der Zelle FU2 ein nein erscheint. Hier müsste das ja bestehen bleiben.

=WENN(FU2="ja";K153;WENN(FU2="";0)) danach zeigt mir die Zelle Falsch an daher habe ich mir eine Hilfszelle erstellt.

=WENNFEHLER(VERWEIS(2;1/K153;K153);"")

Wünsche mir, dass mir jemand helfen kann.

https://filehorst.de/d/dthxpmpF

Die Datei habe ich einmal hochgeladen.

Gruß adde.

Answer 1

Hallo Adde,

ich habe dir mal das Makro im ersten Tabellenblatt für zwei Spieler so angepasst, dass die Punkte der Würfe erst eingetragen werden, wenn ein Doppel geworfen wurde. Somit ist hier Doppel-In und Doppel-Out.

Nur mit Formeln dürfte das kaum umzusetzen sein.

Hier der Link zu bearbeiteten Datei: Doppel-In

Gruß

M.O.

Answer 2

Hallo M.O.

vorab erst einmal vielen lieben Dank für deine Antwort, aber wie immer vergesse ich etwas zu erwähnen. In dieser Datei sollte das Doppel out weg sein. Denn es soll nur Doppel in gespielt werden.

Das andere kann ich doch kopieren und in die Tabellen für 3, 4 usw. Spieler einfügen, oder?

Lieben Gruß und nochmals Danke

Adde

Answer 3

Hallo Adde,

hier der geänderte Code für nur Doppel-In:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim lngSpieler As Long
Dim lngSpalte As Long
Dim lngWurf As Long
Dim lngDT As Long
Dim strSpiel As String
Dim lngZeile As Long
Dim lngSZeile As Long
Dim lngWZeile As Long
Dim lngWSpalte As Long
Dim lngAnsage As Long
Dim bUeberw As Boolean
Dim i As Long

'Nur bei Klick im Bereich von IK2 bis IP12 ausführen
If Intersect(Target, Range("i2", "a2:f12")) Is Nothing Then Exit Sub

ActiveSheet.Unprotect

'nicht in Zelle klicken
Cancel = True

'Bei Klick in I2 = Game on - Ansage starten
If Target.Address = "$I$2" Then
  lngAnsage = 998
  'Ansage starten
  Start_Ansage (lngAnsage)
  'dann Makro wieder verlassen
  Exit Sub
End If

'Nummer des Spielers einlesen
lngSpieler = Range("j1").Value
 
'Spalte für Spieler ermitteln; Spieler stehen in Spalten K bis AH
lngSpalte = 8 + lngSpieler * 3
 
'Prüfen ob Zelle verbunden ist
If Target.Cells.Count > 1 Then
   'falls ja dann die entsprechenden Werte in Variable schreiben
    If Target.Address = "$a$12:$b$12" Then lngWurf = 25
    If Target.Address = "$c$12:$d$12" Then
         lngWurf = 50        '50 Zuweisen
         lngDT = 2           'Marker für Doppel setzen
    End If

         'prüfen, ob Fehlwurf
    If Target.Address = "$e$12:$f$12" Then lngWurf = 0
    
  Else
   'falls kein Fehlwurf
      lngWurf = Target.Value
      If Target.Column = 2 Or Target.Column = 5 Then lngDT = 2  'Marker für Doppel setzen
      If Target.Column = 3 Or Target.Column = 6 Then lngDT = 3   'Marker für Triple setze
End If
'wenn Überworfen,
If Cells(6, lngSpalte) - lngWurf < 0 Then
  'dann Wurfergebnis auf Null setzen
  lngWurf = 0
  'Marker für überworfen setzen
  bUeberw = True
End If

'wenn Überworfen, dann Wurfergebnis auf Null setzen
If Cells(6, lngSpalte) - lngWurf < 0 Then lngWurf = 0
 
'Zeile für Würfe suchen
'dazu die Nr des Spielers herausfinden und damit Suchstring erstellen
strSpiel = "Sp" & Range("J1")
 
'Zeile für Spiel suchen
For lngZeile = 19 To 128
  If Cells(lngZeile, 1).Value = strSpiel Then
    lngSZeile = lngZeile
    Exit For
  End If
Next lngZeile

'Zeile für Eintrag der Würfe suchen
lngWZeile = 19 + WorksheetFunction.RoundDown(Cells(lngSZeile, 10).Value / 3, 0)
   
'Spalte für den Eintrag der Würfe ermitteln
lngWSpalte = WorksheetFunction.RoundDown(Cells(lngSZeile, 10).Value / 3, 0) + 2

'Würfe der Runde auf Null setzen, wenn überworfen
If bUeberw = True Then
  For i = 1 To Cells(lngSZeile, lngWSpalte).Value
    Cells(lngWZeile, lngSpalte + Cells(lngSZeile, lngWSpalte).Value - i) = 0
  Next i
 
End If

'Anzahl Würfe erhöhen
Cells(lngSZeile, lngWSpalte) = Cells(lngSZeile, lngWSpalte).Value + 1

'Anzahl Doppel erhöhen
If lngDT = 2 Then Cells(11, lngSpalte + 1) = Cells(11, lngSpalte + 1).Value + 1
'Anzahl Triple erhöhen
If lngDT = 3 Then Cells(11, lngSpalte + 2) = Cells(11, lngSpalte + 2).Value + 1

'Würfe eintragen
'hier mit Doppel-IN, also nur dann eintragen, wenn 1 Doppel eingetragen wurde
If Cells(11, lngSpalte + 1).Value > 0 Then

    'Würfe eintragen
    Cells(lngWZeile, lngSpalte + Cells(lngSZeile, lngWSpalte).Value - 1) = lngWurf

    'Daten für die Rücknahme des Wurfes in das Array schreiben
     arrRueck(0) = lngSZeile                                            'Zeile für Eintrag des Wurfs
     arrRueck(1) = lngWSpalte                                           'Spalte für Eintrag des Wurfs
     arrRueck(2) = lngSpalte                                            'Spalte für Spieler
     arrRueck(3) = lngWZeile                                            'Zeile für Ergebnis des Wurfs
     arrRueck(4) = lngSpalte + Cells(lngSZeile, lngWSpalte).Value - 1   'Spalte für Ergebnis des Wurfes
     arrRueck(5) = lngDT                                                 'Doppel oder Triple

  Else
     'falls noch kein Doppel vorliegt, Ansage für Wurf in No Score ändern
     lngWurf = 0
     
End If

'hier für die Ansage und Anzeige
'prüfen, ob Überworfen
If bUeberw = True Then
  Start_Ansage (0)
Else
  'prüfen ob Anzahl der Würfe ohne Rest durch 3 Teilbar ist oder Checkout vorliegt
  If Cells(lngSZeile, lngWSpalte).Value Mod 3 = 0 And Cells(1, lngSpalte).Value <> "Checkout" Then
   'Anzeige
    Range("ch169") = "Geworfen: " & Cells(arrRueck(3), arrRueck(4)).Value + Cells(arrRueck(3), arrRueck(4) - 2) + Cells(arrRueck(3), arrRueck(4) - 1) & vbLf & "Rest: " & Cells(6, arrRueck(4) - 2).Value
    lngAnsage = Cells(lngWZeile, lngSpalte + Cells(lngSZeile, lngWSpalte).Value - 1) + Cells(lngWZeile, lngSpalte + Cells(lngSZeile, lngWSpalte).Value - 2) + Cells(lngWZeile, lngSpalte + Cells(lngSZeile, lngWSpalte).Value - 3)
    Start_Ansage (lngAnsage)
    'Anzeige nach 5 Sekunden wieder löschen
    Application.Wait Now + TimeValue("00:00:3")
    Range("ch169") = ""
  End If
End If

'Checkout; 999 = Game over
If Cells(1, lngSpalte).Value = "Checkout" Then Start_Ansage (999)

ActiveSheet.Protect
End Sub

Du kannst diesen Code in jedes Arbeitsblatt kopieren. Lösche das alte entsprechende Makro am besten, bevor du den neuen Code einfügst.

Gruß

M.O.