Klicks addieren excel in vba Liste Erstellen

Question

Hallo liebe Excel Experten

Wer kann mir eine Lösung mitteilen?

Habe die Liste hochgeladen

https://filehorst.de/d/clwIcBrF

Habe schon einmal am Anfang des Jahres diese Frage gestellt und dies wurde durch ein Forum Mitglied gelöst. Nun habe ich aber die Liste verändert und möchte so, das der Klick nicht mehr in den Zellen A9 bis E29 erfolgt sondern von L2 bis AF4. Wollte das VBA verändern kriege es aber nicht gebacken.

Nun mein Problem:

Habe in den Zellen L2 bis AF4 Zahlen eingetragen. Bei Klick auf eine der Zellen, dies geschieht pro Spieler immer 3mal, bei jedem Durchgang bis die Punktzahl erreicht wird, die erforderlich ist. Zum Beispiel 301.

Spieler eins wirft auf Dartscheibe trifft auf Single 16 diese ist in Zelle S3 hinterlegt dann trifft er die Tripple 15 diese ist in Zelle Z4 letzter Wurf von Spieler 1 auf Bulls ist in AF2.

Diese 3 Würfe sollen bei Klick auf diese Zellen in Zelle L9 übernommen werden als Summe in diesem Fall wären das 76 Punkte. Danach soll der Rechenvorgang in der nächsten Leere Zelle also bei mir die Zelle N9) für den zweiten Spieler weiter gehen. Nachdem Spieler 2 seine 3 Würfe erledigt hat soll die Berechnung für Spieler 1 weiter erfolgen. Das Bedeutet die Summe von Durchgang 2 soll in der Zelle L9 zum Durchgang 1 dazu addiert werden usw.

Die Anzahl an Spieler wird durch eine Formel in VBA selektierbar. Das VBA erhielt ich von einem Forum Mitglied. Hier gebe ich in Zelle F1 die Anzahl von Spieler ein. Der Spieler der am Wurf ist wird in Zelle I3 angezeigt.

Durch ein Befehlsfeld

wird durch anklicken der Spieler 1; 2  oder je nachdem  wie viele mit machen, ausgewählt.

Ferner möchte ich gerne; wenn der erste Spieler wirft sollen die  ersten 3 Klicks in Zelle B11 als Zahl 3 übernommen werden. Wenn er seinen 2 Durchgang hinter sich hat soll in Zelle C11 die Zahl 6 erscheinen. Die Addition soll bis Zelle I11 erfolgen Für den 2 Spieler soll es in die darunter liegende Zelle erscheinen.

Für Spieler 1: Hier wird addiert B11+ Klicks = 6 usw. =Zählenwenn(L2:AF4;??? Klick???

Wer kann mir dabei helfen?

Für Hilfe Danke ich schon einmal im Voraus

LG Adde

Answer 1

Vielen Dank für die schnelle Antwort. Bedeutet To 132 gleich die Spalte?

Gruß Adde

Answer 2

Hallo M.O.

Frage hat sich erledigt, habe die Spalten gezählt. 132 ist die Spalte für die letzte Eingabe das muss man aber  erst einmal im Kopf haben, dass das  die Spalte 132 ist.

Gruß Adde

Answer 3

Guten Morgen M.O.

hat man bei der VBA Liste noch die Möglich einen Zusatz einzupflegen?

Folgendes Problem hatte ich gestern. Habe habe eine falsche Zelle angeklickt anstatt einfach 20 habe doppel 20 angeklickt dies konnte ich nicht rückgängig machen.

Gibt es eine Formel letzten Wurf zurücknehmen, dass man dann das richtige Ergebnis anklicken kann?

Für deine Hilfe oder Auskunft Danke ich schon im Voraus.

LG Adde

Answer 4

Hallo Adde,

die einfachste Möglichkeit ist natürlich das Ergebnis per Hand zu korrigieren.

Den letzten Wurf rückgängig machen müsste man per Makro lösen. Ich schaue mal, was ich da machen kann.

Gruß

M.O.

Answer 5

Hallo M.O.

das habe ich auch gedacht aber wenn ich beim zweiten oder dritten Wurf mich verwerfe und entferne es mit entfernen werden alle Würfe dieser Runde gelöscht:

Habe auch vieles probiert aber wie immer kriege ich das in Makro nicht hin. Denke es muss wieder VBA sein.

Gruß Adde

Answer 6

Nochmals ich M.O.

vielleicht kann man den Befehl in das Makro geben -- lösche letzten Klick oder so ähnlich:Nur ich weiß nicht wie ich das eingeben soll.

Gruß Adde

Answer 7

Hallo Adde,

ich schaue mal, was ich da als Makro-Lösung machen kann.

Gruß

M.O.

Answer 8

Hallo Adde,

ersetze das Makro im VBA-Projekt des Arbeitsblattes "Punkteingabe 2 Gewinnlegs" durch das folgende Makro:

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

Dim lngSpieler As Long
Dim lngSpalte As Long
Dim lngPunktSpalte As Long
Dim lngZeile As Long
Static lngErgebnis As Long

'Nur bei Klick im Bereich von L2 bis AF4 ausführen
If Not Intersect(Target, Range("L2:AF4")) Is Nothing Then
  'nicht in Zelle klicken
  Cancel = True
  'Nummer des Spielers einlesen
  lngSpieler = Range("I3").Value
 
  'Würfe  addieren
  'Spieler im Bereich A11 bis A24 suchen
  For lngZeile = 11 To 24
    If Cells(lngZeile, 1).Value = "Sp" & lngSpieler Then
       'Spalte für den Eintrag des Wurfes suchen
       For lngSpalte = 2 To 9
         'Prüfen, ob Wert in Zelle kleiner 3 ist
         If Cells(lngZeile, lngSpalte).Value < 3 Then
           With Cells(lngZeile, lngSpalte)
            'Wurf addieren
            .Value = .Value + 1
            'Zelladresse in Variable für Rückgängig schreiben
             arrRueck(0) = .Address
           End With
          'Schleife verlassen
          GoTo weiter:
         End If
       Next lngSpalte
    End If
  Next lngZeile
   
'Sprungmarke
weiter:
 
  'Punkte addieren, aber nur, wenn kein Fehlwurf
  If Target.Address <> "$AF$4" Then
    'Spieler im Bereich L6 bis AM6 suchen
    For lngPunktSpalte = 12 To 38 Step 2
       If Cells(6, lngPunktSpalte).Value = "Spieler " & lngSpieler Then
         'alter Punktestand in Variable speichern, aber nur, wenn der erste Wurf ausgeführt wurde
         If Cells(lngZeile, lngSpalte).Value = 1 Then lngErgebnis = Cells(9, lngPunktSpalte)
         With Cells(9, lngPunktSpalte)
          'alte Punktzahl in Variable für Rückgängig schreiben
          arrRueck(2) = .Value
          'Punkte addieren
          .Value = .Value + Target.Value
          'Zelladresse in Variable für Rückgängig schreiben
           arrRueck(1) = .Address
         End With
         'Prüfen, ob überworfen
         If Cells(10, lngPunktSpalte).Value < 0 Then
           'alten Punktestand zurückschreiben
           Cells(9, lngPunktSpalte) = lngErgebnis
           'da keine weiteren Würfe mehr, Anzahl der Würfe auf 3 hochsetzen
           Cells(lngZeile, lngSpalte).Value = 3
         End If
         'Schleife verlassen
         Exit For
       End If
    Next lngPunktSpalte
  End If

End If

End Sub

Kopiere das folgende Makro so wie es hier steht in ein allgemenes Modul deiner Arbeitsmappe:

Public arrRueck(2) As Variant
Sub rueckgaengig()

'bei Würfen 1 Wurf abziehen
If Range(arrRueck(0)).Value - 1 > 0 Then
   Range(arrRueck(0)).Value = Range(arrRueck(0)).Value - 1
 Else
   'falls 0, dann 0 löschen
   Range(arrRueck(0)).ClearContents
End If

'alte Punktezahl zurückschreiben
Range(arrRueck(1)).Value = arrRueck(2)

End Sub

Dieses Makro kannst du z.B. einer Schaltfläche zuweisen, die du in deinem Tabellenblatt einfügst.

Gruß

M.O.

Answer 9

Hallo M.O.

vielen lieben Dank alles OK.

Gruß Adde

Answer 10

Hallo M.O.

habe eine Frage zu einer E.- Mail die von Supportnet erhalten, Bezugnehmende auf die "Frage Klicks addieren excel in vba"  und ich weiß nicht an wen ich das schicken sollte. Diese Mail ist sehr dubios für mich schon kriminell.

Man kann diese auch nicht in diesem Chat sehen.

Hier ein Teil von dieser Mail

Wir sind ein Team von Fachleuten mit langjähriger Erfahrung in der Herstellung von gefälschten Pässen und andere Ausweisdokumente, Hersteller von gefälschten Dokumenten in bester Qualität. Mit Mehr als 10 Millionen Dokumente sind weltweit im Umlauf.

An wen soll ich das melden.

Gruß Adde