Zu meiner letzten Frage: Zuordnung von Runden auf Spieleranzahl bei Spinnbutton.

Question

Hallo und guten morgen,

Zu meiner letzten Frage . ich habe etwas entdeckt. das man eventuell, die Befehle, über eine Userform eingeben könnte, da ich aber in VBA ganz wenig Ahnung habe, weil ich die Begriffe nicht zu ordnen kann stehe ich wieder vor für mich eine unlösbare Aufgabe.

Vielleicht kann mir jemand so etwas erstellen.

Das war meine Frage

Beispiel:

In F1 wird die Rundenanzahl eingegeben. In H1 ist die Anzahl der  Spieler und in I1 wird die Anzahl der Spieler mal F1 übernommen.

Ablauf der Befehle:

1.te Runde für, je wieviel Spieler teilnehmen =  2,3,4,5,6,7 bis 8 Spieler sind. Also maximal bis 8 Spieler.

Nehmen wir mal an:

Es sind 2 Spieler und 2 Runden oder mehr:

Dann steht die 2 in H1 für 2 Spieler und in I1 die Zahl 4 (2Spieler*2Runden Usw.).

Über Spinnbutton wird die Zahl verändert. Für Spieler 1 = 1 für 2 =2 usw. bei 2 Spieler ist die Reihenfolge: Erst die 1 dann 2 dann wieder 1, 2 usw. immer abwechselnd , dies geschieht automatisch aber nur wenn die 2 in Zelle I1 steht die die Zahl 4 darin springt es bis zur und dann wieder auf eins zurück.

Mein Ziel ist es:

Solang die 1.Runde noch nicht beendet ist soll I1 maximal die 2 stehen, weil, wenn ich auf Spinnbutton klicke wird aus der 1 die 2. Aber wenn ich jetzt 2 Runden eingebe, wird in der Zelle I1 die 4. Bei Klick auf Spinnbutton wird dann bis 4 weitergezählt, das sollte nicht passieren erst wenn die 1 Runde beendet ist soll In I1 die Zahl 4 erscheinen und dann von 3 auf 4 und nach der 4 zurück auf die 3. Das soll analog für 3 bis 8 Spieler geschehen.

IST dies MÖGLICH?

Also für 3 Spieler 1- 3 bei  2ter  Runde 4 bis 6 usw

Gruß adde

Answer 1

Lösung erstellt

das ist das VBA

Private Sub SpinButton1_Change()
ActiveSheet.Unprotect
Dim lngMin As Long
Dim lngMax As Long

'oberen Wert des Spinbuttons berechnen, abhänging von Anzahl der Spieler (aus Zelle H1) und der aktuellen Runde (aus Zelle F1)
lngMax = Range("H1").Value * Range("F1").Value
'unteren Wert berechnen
lngMin = lngMax - Range("H1").Value + 1

ActiveSheet.Unprotect
If SpinButton1.Value < lngMin Then SpinButton1.Value = lngMax 'fällt Wert kleiner als Minimalwert ist, dann Maximalwert zuweisen
ActiveSheet.Range("J1") = SpinButton1.Value

End Sub
Private Sub SpinButton1_SpinUp()

Dim lngMin As Long
Dim lngMax As Long

'oberen Wert des Spinbuttons berechnen, abhänging von Anzahl der Spieler (aus Zelle H1) und der aktuellen Runde (aus Zelle F1)
lngMax = Range("H1").Value * Range("F1").Value
'unteren Wert berechnen
lngMin = lngMax - Range("H1").Value + 1

ActiveSheet.Unprotect
If SpinButton1.Value > lngMax Then SpinButton1.Value = lngMin     'Falls neuer Wert größer als Maximalwert ist, dann Minimalwert zuweisen
If SpinButton1.Value < lngMin Then SpinButton1.Value = lngMin     'Falls neuer Wert kleiner als Minimalwert ist, dann Minimalwert zuweisen - nur bei neuer Runde
ActiveSheet.Range("J1") = SpinButton1.Value

End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
ActiveSheet.Unprotect
'Bereiche, in dem die 1 eingefügt werden soll
 If Not Intersect(Target, Range("g2")) Is Nothing Then
    Target.Value = 1
    SpinButton1.Min = 1         'untere Grenze für den Spinbutton festlegen
    SpinButton1.Max = 64       'obere Grenze für den Spinbutton festlegen
    Range("f1").Value = 1       'Wert für untere Grenze in Zelle f1 schreiben
    Cancel = True              'Menü nach drücken rechte Maustaste nicht anzeigen
 End If
'Bereiche, in dem die 1 eingefügt werden soll
 If Not Intersect(Target, Range("g12")) Is Nothing Then
    Target.Value = 11
    SpinButton1.Min = 1         'untere Grenze für den Spinbutton festlegen
    SpinButton1.Max = 64       'obere Grenze für den Spinbutton festlegen
    Range("f1").Value = 11       'Wert für untere Grenze in Zelle f1 schreiben
    Cancel = True              'Menü nach drücken rechte Maustaste nicht anzeigen
 End If
 'Bereiche, in dem die 1 eingefügt werden soll
 If Not Intersect(Target, Range("g3")) Is Nothing Then
    Target.Value = 2
    SpinButton1.Min = 1
    SpinButton1.Max = 64
    Range("F1").Value = 2
    Cancel = True              'Menü nach drücken rechte Maustaste nicht anzeigen
 End If
 'Bereiche, in dem die 1 eingefügt werden soll
 If Not Intersect(Target, Range("g4")) Is Nothing Then
    Target.Value = 3
    SpinButton1.Min = 1
    SpinButton1.Max = 64
    Range("F1").Value = 3
    Cancel = True              'Menü nach drücken rechte Maustaste nicht anzeigen
 End If
 'Bereiche, in dem die 65 eingefügt werden soll
 If Not Intersect(Target, Range("g5")) Is Nothing Then
    Target.Value = 4
    SpinButton1.Min = 1
    SpinButton1.Max = 64
    Range("F1").Value = 4
    Cancel = True              'Menü nach drücken rechte Maustaste nicht anzeigen
 End If
 'Bereiche, in dem die 1 eingefügt werden soll
 If Not Intersect(Target, Range("G6")) Is Nothing Then
    Target.Value = 5
    SpinButton1.Min = 1
    SpinButton1.Max = 64
    Range("F1").Value = 5
    Cancel = True              'Menü nach drücken rechte Maustaste nicht anzeigen
 End If
'Bereiche, in dem die 1 eingefügt werden soll
 If Not Intersect(Target, Range("G7")) Is Nothing Then
    Target.Value = 6
    SpinButton1.Min = 1
    SpinButton1.Max = 64
    Range("F1").Value = 6
    Cancel = True              'Menü nach drücken rechte Maustaste nicht anzeigen
 End If
 'Bereiche, in dem die 1 eingefügt werden soll
 If Not Intersect(Target, Range("g8")) Is Nothing Then
    Target.Value = 7
    SpinButton1.Min = 1
    SpinButton1.Max = 64
    Range("F1").Value = 7
    Cancel = True              'Menü nach drücken rechte Maustaste nicht anzeigen
 End If
 'Bereiche, in dem die 65 eingefügt werden soll
 If Not Intersect(Target, Range("g9")) Is Nothing Then
    Target.Value = 8
    SpinButton1.Min = 1
    SpinButton1.Max = 64
    Range("F1").Value = 8
    Cancel = True              'Menü nach drücken rechte Maustaste nicht anzeigen
 End If
 'Bereiche, in dem die 1 eingefügt werden soll
 If Not Intersect(Target, Range("G10")) Is Nothing Then
    Target.Value = 9
    SpinButton1.Min = 1
    SpinButton1.Max = 64
    Range("F1").Value = 9
    Cancel = True              'Menü nach drücken rechte Maustaste nicht anzeigen
 End If
 'Bereiche, in dem die 1 eingefügt werden soll
 If Not Intersect(Target, Range("G11")) Is Nothing Then
    Target.Value = 10
    SpinButton1.Min = 1
    SpinButton1.Max = 64
    Range("F1").Value = 10
    Cancel = True              'Menü nach drücken rechte Maustaste nicht anzeigen
 End If
 'Bereiche, in dem die 1 eingefügt werden soll
 If Not Intersect(Target, Range("rh1")) Is Nothing Then
    Target.Value = 1
    SpinButton1.Min = 1         'untere Grenze für den Spinbutton festlegen
    SpinButton1.Max = 64       'obere Grenze für den Spinbutton festlegen
    Range("h1").Value = 2       'Wert für untere Grenze in Zelle J1 schreiben
    Cancel = True              'Menü nach drücken rechte Maustaste nicht anzeigen
 End If
 'Bereiche, in dem die 1 eingefügt werden soll
 If Not Intersect(Target, Range("ri1")) Is Nothing Then
    Target.Value = 1
    SpinButton1.Min = 1
    SpinButton1.Max = 64
    Range("h1").Value = 3
    Cancel = True              'Menü nach drücken rechte Maustaste nicht anzeigen
 End If
 'Bereiche, in dem die 1 eingefügt werden soll
 If Not Intersect(Target, Range("rj1")) Is Nothing Then
    Target.Value = 1
    SpinButton1.Min = 1
    SpinButton1.Max = 64
    Range("h1").Value = 4
    Cancel = True              'Menü nach drücken rechte Maustaste nicht anzeigen
 End If
 'Bereiche, in dem die 65 eingefügt werden soll
 If Not Intersect(Target, Range("rk1")) Is Nothing Then
    Target.Value = 1
    SpinButton1.Min = 1
    SpinButton1.Max = 64
    Range("h1").Value = 5
    Cancel = True              'Menü nach drücken rechte Maustaste nicht anzeigen
 End If
 'Bereiche, in dem die 1 eingefügt werden soll
 If Not Intersect(Target, Range("rl1")) Is Nothing Then
    Target.Value = 1
    SpinButton1.Min = 1
    SpinButton1.Max = 64
    Range("h1").Value = 6
    Cancel = True              'Menü nach drücken rechte Maustaste nicht anzeigen
 End If
  'Bereiche, in dem die 65 eingefügt werden soll
 If Not Intersect(Target, Range("rm1")) Is Nothing Then
    Target.Value = 1
    SpinButton1.Min = 1
    SpinButton1.Max = 64
    Range("h1").Value = 7
    Cancel = True              'Menü nach drücken rechte Maustaste nicht anzeigen
 End If
 'Bereiche, in dem die 1 eingefügt werden soll
 If Not Intersect(Target, Range("rn1")) Is Nothing Then
    Target.Value = 1
    SpinButton1.Min = 1
    SpinButton1.Max = 64
    Range("h1").Value = 8
    Cancel = True              'Menü nach drücken rechte Maustaste nicht anzeigen
 End If
 
ActiveSheet.Protect
End Sub

Gruß Adde