192 Aufrufe
Gefragt in Tabellenkalkulation von addeguddi Experte (1.2k Punkte)
Hallo an das Forum Supportnet Team

Wer kann mir eine Lösung zu meinem Problem geben?

Hierbei handelt es sich um ein Dartspiel mit dem Namen: Die Fuchsjagd.

Möchte noch erwähnen, habe in VBA keine Ahnung

Nun zu meiner Bitte und mein Problem:

In der Zelle IE1 wird eine Zahl händig eingegeben und bei Doppelklick in Zellen IK2 bis IN11 funktioniert alles so Lange, wie ich es manuell eingebe, so wie es sein soll.

Doch wenn ich eine Formel in die Zelle IE1 eingebe und ich einen Doppelklick auf die Zellen, entweder IK2 oder IN5 Klicke erscheint:  Laufzeitfehler`13` Typen unverträglich.

Das ist die Formel die in der Zelle IE1 Hinterlegt werden soll.

=WENN(ODER($IB$15=230;$IC$15=230);"230";"")

Hiermit soll erreicht werden, wenn der Wert in IB15 oder IC15 erreicht ist, ist mein Spiel beendet.

In diesen Zellen sind folgende Formel hinterlegt:

In Zelle IB 15: =WENN(IDENTISCH($KE$25;$KJ$25);230;"")

In Zelle IC 15: =SUMME($KE$3:$KE$23)

Für Hilfe wäre ich sehr dankbar

Gruß Adde

26 Antworten

0 Punkte
Beantwortet von addeguddi Experte (1.2k Punkte)
Hallo M.O.

es ist vollbracht. Alles funktioniert.

Vielen lieben Dank

Gruß Adde
0 Punkte
Beantwortet von addeguddi Experte (1.2k Punkte)
Guten Morgen M.O.

ich war wieder einmal zu schnell mit meiner Antwort, das alles funktioniert. Bis auf das , dass alles angesagt wird, ist auch OK aber was mir noch fehlt, ist das, dass die Anzahl der Würfe nur bei den Zahlen 1 bis 20 gezählt werden aber wenn ich auf die 0 klicke wird dieser Wurf nicht mit gezählt.

Beispiel: 20 ist Wurf 1, 5 ist Wurf 2, 0 Wurf drei. Bei der Anzahl der Würfe erscheint die 2. Sollte aber eine 3 erscheinen usw..

Wenn du noch einmal so Nett bist und prüfst ob es dafür eine Lösung gibt.

Ich DANKE dir jetzt schon einmal Voraus

Gruß

Adde
+1 Punkt
Beantwortet von m-o Profi (18.4k Punkte)

Hallo Adde,

ja, da hatte ich einen Denkfehler.

So sollte das Makro jetzt funktionieren:

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 lngAnzahl As Long
Dim lngAnsage As Long
Dim i As Long

'Nur bei Klick im Bereich von IK2 bis IP12 ausführen
If Intersect(Target, Range("ie1, ij3, ik2:in12")) Is Nothing Then Exit Sub

'nicht in Zelle klicken
Cancel = True

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

'Arbeitsblatt entsperren
ActiveSheet.Unprotect

'Nummer des Spielers einlesen
lngSpieler = Range("G1").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 = "$IK$12:$IL$10" Then lngWurf = 25
    If Target.Address = "$IM$12:$I0$12" Then
         lngWurf = 50        '50 Zuweisen
         lngDT = 2           'Marker für Doppel setzen
    End If
End If

'prüfen, ob Fehlwurf
If Target.Address = "$Ij$3" Then
     lngWurf = 0
   Else
   'falls kein Fehlwurf
      lngWurf = Target.Value
      If Target.Column = 246 Or Target.Column = 249 Then lngDT = 2  'Marker für Doppel setzen
      If Target.Column = 247 Or Target.Column = 250 Then lngDT = 3   'Marker für Triple setze
End If
 
 
'Zeile für Würfe suchen
'dazu die Nr des Spielers herausfinden und damit Suchstring erstellen
strSpiel = "Sp" & Range("G1")
 
'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
'Anzahl der Würfe auslesen
'Prüfen, ob schon eine Zahl in Spalte J steht
If Cells(lngSZeile, 10) = "" Then
  lngAnzahl = 0
 Else
  lngAnzahl = Cells(lngSZeile, 10).Value
End If

lngWZeile = 19 + WorksheetFunction.RoundDown(lngAnzahl / 3, 0)
   
'Spalte für den Eintrag der Würfe ermitteln
lngWSpalte = WorksheetFunction.RoundDown(lngAnzahl / 3, 0) - WorksheetFunction.RoundDown(lngAnzahl / 24, 0) * 8

If lngWSpalte = 0 Then lngWSpalte = 2

'Anzahl Würfe erhöhen

lngAnzahl = lngAnzahl + 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
Select Case lngAnzahl - Int(lngAnzahl / 3) * 3
  Case Is = 0
    Cells(lngWZeile, lngSpalte + 2) = lngWurf
    arrRueck(4) = lngSpalte + 2                   'Spalte für Ergebnis des Wurfes
  Case Is = 1
    Cells(lngWZeile, lngSpalte) = lngWurf
    arrRueck(4) = lngSpalte
  Case Is = 2
    Cells(lngWZeile, lngSpalte + 1) = lngWurf
    arrRueck(4) = lngSpalte + 1
End Select

'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
'Ansage Wurfergebnis
If lngWurf > 0 Then Start_Ansage (lngWurf)

'Checkout; 999 = Game over
If Range("IE1").Value = 230 Then Start_Ansage (999)
ActiveSheet.Protect
End Sub


Gruß

M.O.

0 Punkte
Beantwortet von addeguddi Experte (1.2k Punkte)
Hallo M.O.
vielen Dank für deine Antwort. Jetzt zählt er wieder die Würfe, doch die Ansage No score bei Klick auf 0 wird nicht angesagt. Füge ich den unteren Code ein, wird die Ansage getätigt aber dann wird der Wurf 0 nicht Addiert.
If Target.Address = "$IJ$3" Then
 '0 = No Score
 lngAnsage = 0
 'Ansage starten
 Start_Ansage (lngAnsage)
 'dann Makro wieder verlassen
 Exit Sub
End If
Gruß Adde
+1 Punkt
Beantwortet von m-o Profi (18.4k Punkte)

Hallo Adde,

das mit der Ansage konnte ich natürlich nicht testen und hatte das übersehen. Ändere die Zeile

If lngWurf > 0 Then Start_Ansage (lngWurf)

in

Start_Ansage (lngWurf)

Gruß

M.O.

0 Punkte
Beantwortet von addeguddi Experte (1.2k Punkte)
Hallo M.O.

Danke. Jetzt ist alles OK.

Grus Adde
...