49 Aufrufe
Gefragt in Tabellenkalkulation von addeguddi Experte (1.1k Punkte)
Hallo und einen schönen Tag an das Forum

hatte in meiner letzen Frage nach einer Lösung gesucht für Wiedergabe über Sound die mir auch als Lösung zur Verfügung gestellt hat und die auch funktioniert doch ´habe ich leider nicht soweit gedacht, dass die Ansage jetzt bei dieser Lösung immer nach jedem Wurf die Ansage kommt. Eigentlich soll die Ansage erst zugreifen wenn der DRITTE Wurf getätigt ist.

Beispiel: Für Spieler eins. 1. Wurf 20, 2. Wurf 15, 3. Wurf 60 hier Gesamt = 95 und dies sollte angesagt werden. Die einzelne Punkte werden von K 19 bis M19 für die 1. 3 Würfe, für die 2. 3 Würfe in K20 bis M20 usw. eingetragen die Gesamtsumme erscheint in K130.

Das ist die Überschrift für die Auswahl der Würfe
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Wenn mir jemand eine Lösung zukommen lassen wäre ich sehr, sehr Dankbar

Gruß Adde

7 Antworten

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

Hallo Adde,

ich habe mal ein Makro aus einer Datei, die ich noch von dir habe entsprechend ergänzt. Im Prinzip habe ich bei der Deklaration nur die Variable lngAnsage und die Zeilen ab "hier für die Ansage" am Ende des Makros ergänzt. Schau mal, ob das so geht, wie du dir das vorstellst:

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

'Nur bei Klick im Bereich von A4 bis F14 ausführen
If Intersect(Target, Range("A4:F15")) Is Nothing Then Exit Sub

'nicht in Zelle klicken
Cancel = True
    
'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 = "$A$15:$B$15" Then lngWurf = 25
    If Target.Address = "$C$15:$D$15" Then
         lngWurf = 50        '50 Zuweisen
         lngDT = 2           'Marker für Doppel setzen
    End If
      'prüfen, ob Fehlwurf
    If Target.Address = "$E$14:$F$14" 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 setzen
End If
    
'wenn Überworfen, dann Wurfergebnis auf Null setzen
If Cells(6, lngSpalte) - lngWurf < 0 Then lngWurf = 0
   
'Falls nur 1 übrigbleibt und damit kein Doppel-Out möglich ist, Wurf auf Null setzen
If Cells(6, lngSpalte) - lngWurf = 1 Then lngWurf = 0
 
'Fall kein Check-Out mit Doppel, dann Ergebnis des Wurfes auf Null setzen
If Cells(6, lngSpalte) - lngWurf = 0 And lngDT <> 2 Then lngWurf = 0
 
'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
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

'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
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

'hier für die Ansage
'prüfen ob Anzahl der Würfe ohne Rest durch 3 Teilbar ist oder Checkout vorliegt
If Cells(lngSZeile, lngWSpalte).Value Mod 3 = 0 Or Cells(1, lngSpalte).Value = "Checkout" Then
  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)
End If

End Sub

Gruß

M.O.

0 Punkte
Beantwortet von addeguddi Experte (1.1k Punkte)

Hallo und einen schönen Tag

vielen lieben Dank. Habe es eingefügt und jetzt ist es so, das die Ansage nach dem 3 . Wurf ertönt. Supersmiley

Gruß Adde

+1 Punkt
Beantwortet von m-o Profi (18.1k Punkte)
Hallo Adde,

gern geschehen.

Gruß

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

bin es noch einmal. Eine Nachfrage: kann man noch eine Zeile in das Makro setzen wenn 301 oder 501 erreicht ist, das dann Game Over angesagt wird?. Ist in Sounddatei enthalten

Lieben Gruß

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

Hallo Adde,

dann Ändere den letzten Teil des Makro wie folgt ab:

'hier für die Ansage
'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
  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)
End If

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

End Sub


Die Ansage "Game over" muss hier mit dem Dateinamen 999 hinterlegt sein, weil an das Makro zum Abspielen mit dem Sound nur Zahlen übergeben werden können. Die Zahl für die Datei kannst du aber entsprechend auf deine Verhältnisse anpassen.

Gruß

M.O.

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

vielen, vielen Dank. Top Leistung was du das machst. Hoffe, ich kann das irgendwann auch einmal.

Gruß Adde
0 Punkte
Beantwortet von m-o Profi (18.1k Punkte)

Hallo Adde,

danke, ich übe ja auch schon lang genug wink.

Gruß

M.O.

...