Werte werden nur von K19 bis An 127 Eingetragen danach ab AM19 Bis CD 127 überschrieben

Question

Hallo wieder mal ein Problem.

Ein Kollege von eurem Team hat mir einmal ein VBA erstellt. Nun funktioniert es nicht mehr so wie sollte. Es müsste irgendwie in der Zuordnung Bei Würfe eintragen oder bei'Spalte für den Eintrag der Würfe ermitteln
lngWSpalte = WorksheetFunction.RoundDown(lngAnzahl / 3, 0) - WorksheetFunction.RoundDown(lngAnzahl / 10, 0) * 8 dies ist nur ein Teil von VBA.

ich weiß es nicht. Irgendwo müsste die Zuordnung geändert werden.

Würde gerne die Datei hochladen, dass wenn jemand helfen möchte, es einmal ausprobiert was ich meine und  er oder sie einmal ab Spiel 11 Testet was ich meine.

Kurze Erläuterung: Spieler werden über Spin Button ermittelt.

Spieler 1 Beginnt:

Sein erstes Ergebnis wird bei Klick in ein Zahlenfeld in Zelle K19 übernommen beim beim zweiten Klick in Zelle L19 und dritter Klick in M19 spielt er alleine wird bei jedem nächsten Klick K20, L20 M20 usw. Für Spieler zwei werden die werte beginnend mit N19 usw. also für jeden Spieler sind drei Spalten vorgesehen.

Bei Klick wird der Wert

Vielleicht kann sich  jemand das VBA einmal schauen.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
ActiveSheet.Unprotect
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:io12")) 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

'Nummer des Spielers einlesen
lngSpieler = Range("G1").Value
 
'Spalte für Spieler ermitteln; Spieler stehen in Spalten K bis CB
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$12" Then lngWurf = 25
    If Target.Address = "$IM$12:$I0$12" Then
         lngWurf = 50        '50 Zuweisen
         lngDT = 2           'Marker für Doppel setzen
    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 100
  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 / 10, 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
Start_Ansage (lngWurf)

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

In der Hoffnung, dass ich mich ein wenig Verständnisvoll ausgedrückt habe. Für mich ist es sehr schwer das nieder zu schreiben was ich möchte.

Gruß Adde

Answer 1

Hallo und guten Morgen,

meine Hilfe an das Support Team hat sich erledigt, da ich wieder einmal eine Lösung gefunden habe.

Im Falle, dass jemand dies bearbeiten wollte, danke ich ihm dafür, ist jetzt aber nicht mehr nötig.

Vielleicht kommt irgendwann wieder eine Frage von mir.

Bis dahin Grüße und bleibt gesund.

Adde

Answer 2

Hi Adde,

wenn du eine Lösung gefunden hast, dann wäre das super, wenn du die hier auch veröffentlichen könntest, dann würden nachfolgende Lösungssucher die auch finden können.

Gruß Fabian

Answer 3

Hallo Fabian Guten Morgen,

ich hätte die Lösung schon einpflegt, doch nach dem ich weiter probiert habe, war es  so wie ich es beschrieben habe. also war meine Rückmeldung zu schnell. Mit der Lösung und habe immer noch das Problem.

Bin weiterhin am ausprobieren wie ich das schaffe, denke aber, dass ich das nicht lösen kann.

Vielleicht kann doch noch jemand mich dabei unterstützen.

Gruß Adde