Einsargen (13 Striche sammeln), Anzahl Kegler verringert sich

[Steffl]

Hallo André,

ist diese Abfrage

Code:

If iRowEintrag = 0 Then iRowEintrag = WorksheetFunction.CountA(Columns(1))

nicht überflüssig? Denn hier

Code:

If iRowEintrag = 0 Then
        iRowEintrag = WorksheetFunction.CountA(Columns(1))

frägst Du sie ja nochmals ab.

[schauan]

Hallo Stefan,

ja, einmal reicht Ansonsten könnte die Prüfung auch falsch ausgehen Ich hab das mal noch korrigiert.

[WergibtmirRat]

...schwere Geburt...diesmal scheint's zu klappen...Falls nicht...

Hallo André,
da muß nochmal das Skapell dran. Das Kind steckt mit dem Hals im Schlamassel fest.
Fehler bei:
Wert 1 in alle Zellen geholt = nur Name 8 mit 1 stimmt
Wert 2 in alle Zellen geholt = nur Name 6 mit 2 stimmt nicht
Wert 3 in alle Zellen geholt = nur Name 5 mit 3 stimmt nicht
ich schätze mal, der Fehler wird weiter steigen 4 zu 4;3 zu 5; 2 zu 6.

hatte leider keine Zeit um alles durchzutesten.
Wo mag da ader Fehler liegen?
Bin auf deine Hilfe weiter gespannt und den anderen Helfern
un bye bye ab in die Heija - Früh-früh

[WergibtmirRat]

Hallo @all
melde mich nach intensivster Suche und probieren im Code, komme nicht weiter.
1ster Fehler:
Sprungmarke ist beim Werfer, Name 1 wirft eine 1 bekommt selber die 1 (Zeilenzähler steht vielleicht verkehrt)
Wenn nun jeder Werfer von 8 herunter wirft, stimmt die Anzeige. Werfer 1 hat 8 Treffer
Das komische ist halt das die unteren Wurf fast alle stimmen
Name_Wurf__Stand__soll bei
1______1______2______2
2______1______1______3
3______1______1______4
4______1______1______5
5______1______1______6
6______1______1______7
7______1______-_____9
8______1______1______2

Ich bitte um eure Hilfe
oder doch mit Formeln

[schauan]

Hallo Frank,

jetzt hab ich noch mehr Varianten getestet ....

Code:

Sub zaehlen()
                                    'Variablendeklarationen
                                    'Integer
Dim iRowEintrag%, iCnt%, iRow%
                                    'D10 leeren
Cells(10, 4).ClearContents
                                    'Sub verlassen, wenn nur noch ein Spieler < 13 Punkte hat
                                    'Hinweis: wenn in Spalte C unterhalb des Punktebereichs auch eine 13 stehen kann, dann
                                    'muss der Bereich zum Zaehlen begrenzt werden!
If WorksheetFunction.CountIf(Columns(3), 13) = WorksheetFunction.CountA(Columns(1)) - 2 Then Exit Sub
                                    'Zeile der Aktiven Zelle festhalten
iRow = ActiveCell.Row - 1
                                    'Zeile fuer eintrag berechnen
iRowEintrag = (ActiveCell.Value + iRow) Mod (WorksheetFunction.CountA(Columns(1)) - 1)
If iRowEintrag = 0 Then _
   iRowEintrag = WorksheetFunction.CountA(Columns(1)) - 1
                                    'Weiter, solange Ziel schon 13 Punkte hat
Do While Cells(iRowEintrag + 1, 3) = 13
                                    'Zeile fuer Eintrag berechnen
  iRowEintrag = (iRowEintrag + 1) Mod (WorksheetFunction.CountA(Columns(1)) - 1)
  If iRowEintrag = 0 Then _
     iRowEintrag = WorksheetFunction.CountA(Columns(1)) - 1
Loop
                                    'Zeilennummer fuer Eintrag eintragen
Cells(10, 4) = iRowEintrag
                                    'Punkte 1 hochzaehlen
Cells(iRowEintrag + 1, 3) = Cells(iRowEintrag + 1, 3) + 1
End Sub

[WergibtmirRat]

Hallo André
Danke für deine unermütliche Hilfe :18:, der Code läuft anfangs gut, nur wenn z.b. Name 1 schon 13 Treffer hat, wird dieser in der weiteren Berechnung noch mit berücksichtig.

  M2.xlsm (Größe: 28,08 KB / Downloads: 1)

Ich habe mal den Namen eine kleine Formel beigefügt, damit der schon 13 Treffer hat auf Null gestellt ist.
Anbei in der Datei verschiedene Ansichten des Verhaltens und grafische Darstellungen

und schon wieder ein graues Haar ...
schönen Tag noch

[schauan]

Hallo Frank,
Lösung kommt morgen ...

[schauan]

Hallo Frank,

jetzt ist der code hoffentlich clever genug, dass es klappt - zum Glück ist das Forum belastbar . Ich war's gestern Abend nicht - bin eingeschlafen und erst kurz vor 10 aufgewacht...

Wieder eine neue Variante. Diesmal kannst Du auch unter die Spieler etwas schreiben. Das Ende der Spielereinträge wird durch eine Leerzelle unter A3 definiert. Es sollten mindestens zwei Mitspieler sein

Code:

Sub zaehlen4()
                                    'Variablendeklarationen
                                    'Integer
Dim iCnt1%, iRow%, iHit%
Dim arrTmp                          'Variant-Array
                                    'D10 leeren
Cells(10, 4).ClearContents
                                    'Daten uebernehmen
iRow = ActiveCell.Row - 1           'Positionszaehler, Zeile der aktiven Zelle - 1
iHit = ActiveCell.Value             'Wurf
                                    'alle Stände aus Spalte C in Array uebernehmen
                                    'Hinweis: Laenge Datenbereich anhand Spalte A
                                    'Ab A2 nach unten bis ueber erste leere Zelle
arrTmp = WorksheetFunction.Transpose(Range("A2:A" & Cells(2, 1).End(xlDown).Row).Offset(, 2).Value)
                                    'Sub Verlassen, wenn alle bis auf einen 13 Treffer haben
If WorksheetFunction.Sum(arrTmp) = 13 * UBound(arrTmp) - 1 Then Exit Sub
                                    'Schleife bis zum Ziel ueber alle Eintraege
                                    '
iCnt1 = 0
Do While iCnt1 < iHit
  iRow = iRow + 1                   'Positionszaehler hochsetzen, ist er groesser als die
                                    'Anzahl der Mitspieler, zuruecksetzen auf 1
  If iRow > UBound(arrTmp) Then iRow = 1
                                    'Schleifenzaehler hochsetzen, wenn Eintrag < 13
  If arrTmp(iRow) < 13 Then iCnt1 = iCnt1 + 1
Loop

                                    'Zeilennummer fuer Eintrag eintragen
Cells(10, 4) = iRow + 1
                                    'Stand hochzaehlen
Cells(iRow + 1, 3) = Cells(iRow + 1, 3) + 1
End Sub

[WergibtmirRat]

...gestern Abend nicht - bin eingeschlafen...

Hallo André, bin ebenfalls hundemüde. Dries Spätschicht bis 0 Uhr, deswegen auch nur hier ganz kurz erwähnt. Habe mir die Kommentare durchgelesen im Code, was da steht ist hoch erfreulich. Werde sobald ich Zeit bekomme Zaehlen3 durch den neuen ersetzen.

Werde berichten nach reichlich durchspielen der verschiedensten Szenarien.

Mein nächster Gedanke wäre, wie die einzelnen Wurf dem Werfer zuordnen. Da auch die geworfenen Holz jeder Person zusammen addiert werden. Momentan ist ja die "ActiveCell" im Fokus auf dem Tabellenblatt. In einer Userform über eine Textbox erfolgen soll. Bin damit schon am frickeln.
Aber dazu erst später... , so Zahnarzt will mich auf'm Stuhl seh'n.

Danke Dir vielmals André