[Haseron]

Guten Abend allen,

so mein Anliegen ist wie mehr oder weniger oben zu lesen, das ich im Unterrichtsfach Informatik ein Spiel in Excel 2007 programmieren muss und nicht richtig weiß was da zu realisieren ist.
Das Spiel sollte nicht zu komplex sein aber auch nicht zu einfach.
Wenn mir jemand einen Ratschlag geben könnte was da alles so möglich ist oder mir sogar "helfen" könnte beim programmieren, wäre ich dem jenigen sehr verbunden. ^^
Achja das Spiel muss ich am Freitag meinem Lehrer vorlegen.

Schönen Abend euch noch und danke schonmal

[eitch100]

Zitat von Haseron

Das Spiel sollte nicht zu komplex sein aber auch nicht zu einfach.

Da wird dir so keiner helfen können, weil niemand weiß, was für dich schwer oder leicht ist und was du für Kenntnisse in Excel/VBA hast. Am Besten du googlst erstmal danach, um dir Anregungen zu holen. Da gibt es die einfachsten Zahlenratespiele oder Kopfrechnenspiele bis zu Umsetzungen bekannter Klassiker wie Minesweeper...

Hier ist mal ein kleiner VBA_Code zum Zahlenraten... also einen Commandbutton anlegen und folgenden Code einfügen...

Private Sub CommandButton1_Click()

Dim i As Integer
Dim n

n = 1
[A:A].ClearContents
Randomize
i = Int((100 - 0 + 1) * Rnd + 0)


Do

a = InputBox("Bitte raten.")
    
    If i > a Then
    MsgBox "Grösser"
    Cells(n, 1).Value = "Versuch " & n & " war " & a & ", die Lösung ist größer."
    End If
    
    If i < a Then
    MsgBox "Kleiner"
    Cells(n, 1).Value = "Versuch " & n & " war " & a & ", die Lösung ist kleiner."
    End If
    
    If i = a Then
    MsgBox "Gewonnen"
    Cells(n, 1).Value = a & " ist richtig! Das waren " & n & " Versuche."
    Exit Sub 'Damit es keine Endlosschleife wird
    End If
 
    n = n + 1
    
Loop

End Sub

[Haseron]

Vielen Dank für Antwort schonmal und auch für den Code nur denke ich das das Spiel schon zu simpel wäre.
Ja dann drücke ich mich etwas genauer aus. Nun der Schwierigkeitsgrad dieses Programms/Spiels sollte auf dem Niveau deiner schon genannten Klassiker liegen. Ich hätte mir sehr gerne Snake, Schach oder ähnliches als Spiel gewünscht, nur fehlt mir die gewisse herangehensweise an die Programmierung.

Vllt. hilft ja das ein bisschen weiter um zu verstehen welchen Anspruch das Spiel haben sollte.

MfG,
Haseron

[c-walt]

Black Jack sollte sich ebenfalls recht einfach umsetzen lassen. Natürlich dann nicht mit grafischen Karten, sondern nur deren Werten, aber der Rest ist relativ simpel.
Alle Werte definieren und dann einen Randomwert auswählen. Der jeweils gewählte Wert darf kein zweites Mal ausgewählt werden.
Eine Abfrage, ob eine weitere Karte gezogen werden soll. Falls ja, dann die Werte addieren. Wenn Du über 21 landest, gibt es eine Ausgabe, dass Du verloren hast.

/edit:
Google kannst Du aber selbst nutzen, oder? Gibt genügend Quelltexte zur Umsetzung der verschiedensten Spiele in Excel mit VBA. excel + vba + spielename bringt so viele Ergebnisse zu Tage, dass Du Deinen Lehrer mit Programmen totwerfen kannst.

Falls Du es nerdy magst: programmier ein Remake von Zork.

[Iliaz]

Schiffe versenken, hatten wir mal in der 11ten. Denke aber das wird wohl zu einfach sein für dich.

[eitch100]

Vielleicht findest du hier bzw. auch drum herum etwas Brauchbares...
[ Link nur für registrierte Mitglieder sichtbar. Bitte einloggen oder neu registrieren ]

[Haseron]

Danke Leute!
Mal noch ne Frage bezüglich der VBA. Was gibt es denn da für Möglichkeiten von grafischen Oberflächen?

Ach, sind Excel 2000/97/XP VBAs kompatibel mit Excel 2007?

[eitch100]

Von grafischen Oberflächen habe ich da keine Ahnung, aber unter den Excel-Versionen (und ich meine besonders ab Excel 2007) gibt es zumindest bei einigen Befehlen Unterschiede. Aber dafür gibt es dann einen Kompatibilitätsmodus. Hier was allgemeines dazu...
[ Link nur für registrierte Mitglieder sichtbar. Bitte einloggen oder neu registrieren ]

Hier mal Tetris für VBA in Excel...
[ Link nur für registrierte Mitglieder sichtbar. Bitte einloggen oder neu registrieren ]

[Haseron]

Ja den Quellcode hab ich auch schon entdeckt auf der Seite, aber danke! :P
Ja aber ich denke mein Lehrer wird mir niemals abkaufen dass "ich"das programmiert habe
Abgabetermin ist am Freitag ich durchkäme grade das Internet nach Quellcodes die in Frage kommen würden

[Haseron]

So ich hab eigtl. ein Spiel das ich ganz gerne nehmen würde aber mein Wissensstand reicht nicht aus um die Vorgänge im Quellcode nachzuvollziehen und erklären zu können aber was "einfacheres" als das Spiel find ich auch nicht
Hier mal der Quellcode von Senso (mein gewünschtes Spiel):

Option Explicit
Option Base 1

Dim iMax As Integer
Dim iCounter As Integer
Dim iZufall(50) As Integer
Dim iFarbe_R(9), iFarbe_G(9), iFarbe_B(9) As Integer
Dim i, i2, j, k, l As Integer
Dim sPauseKlein, sPauseGross As Single

Sub Auto_Open()
ThisWorkbook.Worksheets("Senso").Activate
iMax = ThisWorkbook.Worksheets("Init").Cells(1, 2).Value
sPauseKlein = ThisWorkbook.Worksheets("Init").Cells(3, 2).Value
sPauseGross = ThisWorkbook.Worksheets("Init").Cells(4, 2).Value
Randomize Timer

For i = 1 To iMax
ThisWorkbook.Worksheets("Zufall").Cells(i, 2).Value = 0
Next i

For i = 1 To 9
iFarbe_R(i) = ThisWorkbook.Worksheets("Init").Cells(i + 5, 2).Value
iFarbe_G(i) = ThisWorkbook.Worksheets("Init").Cells(i + 5, 3).Value
iFarbe_B(i) = ThisWorkbook.Worksheets("Init").Cells(i + 5, 4).Value
Next i

For i = 1 To 9
Call ButtonColor(i)
Next i

k = 0

For i2 = 1 To iMax + 3
ThisWorkbook.Worksheets("Senso").Cells(i2 + 2, 1).Value = ""
ThisWorkbook.Worksheets("Senso").Cells(i2 + 2, 2).Value = ""
ThisWorkbook.Worksheets("Senso").Cells(i2 + 2, 2).Font.Color = RGB(0, 0, 0)
ThisWorkbook.Worksheets("Senso").Cells(i2 + 2, 2).Interior.Color = 12632256
ThisWorkbook.Worksheets("Senso").Cells(i2 + 2, 3).Interior.ColorIndex = 15
Next i2
ThisWorkbook.Worksheets("Senso").Cells(4, .Value = "nn"
End Sub

Private Sub CommandButton10_Click()
End
End Sub

Private Sub CommandButton11_Click()
For i = 0 To 56
ThisWorkbook.Worksheets("Senso").Cells(40, 1).Interior.ColorIndex = i
Call MsgBox("Colorindex=" + Str(i), vbOKOnly)
Next i
End Sub

Private Sub CommandButton1_Click()
Call Einsetzen_und_Prüfe(1)
End Sub

Private Sub CommandButton1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Call Einsetzen_und_Prüfe(1)
End Sub

Private Sub CommandButton2_Click()
Call Einsetzen_und_Prüfe(2)
End Sub

Private Sub CommandButton2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Call Einsetzen_und_Prüfe(2)
End Sub

Private Sub CommandButton3_Click()
Call Einsetzen_und_Prüfe(3)
End Sub

Private Sub CommandButton3_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Call Einsetzen_und_Prüfe(3)
End Sub

Private Sub CommandButton4_Click()
Call Einsetzen_und_Prüfe(4)
End Sub

Private Sub CommandButton4_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Call Einsetzen_und_Prüfe(4)
End Sub

Private Sub CommandButton5_Click()
Call Einsetzen_und_Prüfe(5)
End Sub

Private Sub CommandButton5_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Call Einsetzen_und_Prüfe(5)
End Sub

Private Sub CommandButton6_Click()
Call Einsetzen_und_Prüfe(6)
End Sub

Private Sub CommandButton6_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Call Einsetzen_und_Prüfe(6)
End Sub

Private Sub CommandButton7_Click()
Call Einsetzen_und_Prüfe(7)
End Sub

Private Sub CommandButton7_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Call Einsetzen_und_Prüfe(7)
End Sub

Private Sub CommandButton8_Click()
Call Einsetzen_und_Prüfe(
End Sub

Private Sub CommandButton8_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Call Einsetzen_und_Prüfe(
End Sub

Private Sub CommandButton9_Click()
Call Einsetzen_und_Prüfe(9)
End Sub

Private Sub CommandButton9_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Call Einsetzen_und_Prüfe(9)
End Sub

Private Sub CommandButtonReset_Click()
Call Auto_Open
End Sub

Private Sub CommandButtonStart_Click()
If k > 0 Then
GoTo Weiter
End If

'UserForm1.Show besser mit TextBox

Dim Mldg, Titel, Voreinstellung, Wert1
Mldg = "Bitte vor dem Spiel noch den Namen eingeben ..."
Titel = "Name"
Voreinstellung = ThisWorkbook.Worksheets("Senso").Cells(4,
' Meldung, Titel und Standardwert anzeigen.
Wert1 = InputBox(Mldg, Titel, Voreinstellung)
If Wert1 = "" Then
End
End If


Call Wait_A_Minute(1)
Call Auto_Open

For i = 1 To 9
Call ButtonBlack(i)
Next i

Call Wait_A_Minute(1)

For i = 1 To iMax
iZufall(i) = Int((Rnd * 9) + 1)
' TEST If i < 5 Then iZufall(i) = 2
ThisWorkbook.Worksheets("Zufall").Cells(i, 1).Value = iZufall(i)
Next i

For i = 1 To 9
Call ButtonColor(i)
Next i

Call Wait_A_Minute(1)

'UserForm1.Show
'Call Wait_A_Minute(1)

Weiter:
k = k + 1
Call Game_Play
DoEvents

End Sub

Private Sub Game_Play()
' For j = 1 To k
' ThisWorkbook.Worksheets("Senso").Cells(5 + j, 2).Interior.ColorIndex = 5
' Next j

For j = 1 To k
Call ButtonBlack(iZufall(j))
ThisWorkbook.Worksheets("Senso").Cells(5 + j, 2).Interior.ColorIndex = 16
DoEvents
Call Wait_A_Minute(sPauseKlein)

Call ButtonColor(iZufall(j))
DoEvents
Call Wait_A_Minute(sPauseKlein)
Next j

l = 0
' Call Wait_A_Minute(sPauseGross)


End Sub

Private Sub Einsetzen_und_Prüfe(Ziffer As Integer)
l = l + 1
ThisWorkbook.Worksheets("Senso").Cells(5 + l, 2).Interior.ColorIndex = 4

'ThisWorkbook.Worksheets("Senso").Cells(40, 1).Value = l
'ThisWorkbook.Worksheets("Senso").Cells(40, 2).Value = k

ThisWorkbook.Worksheets("Zufall").Cells(l, 2).Value = Ziffer
If ThisWorkbook.Worksheets("Zufall").Cells(l, 1).Value <> _
ThisWorkbook.Worksheets("Zufall").Cells(l, 2).Value Then

ThisWorkbook.Worksheets("Senso").Cells(3, 1).Value = "Zufalls-"
ThisWorkbook.Worksheets("Senso").Cells(4, 1).Value = "zahlen"
ThisWorkbook.Worksheets("Senso").Cells(3, 2).Value = "Ihre"
ThisWorkbook.Worksheets("Senso").Cells(4, 2).Value = "Zahlen"

For i2 = 1 To k
ThisWorkbook.Worksheets("Senso").Cells(i2 + 5, 1).Value = ThisWorkbook.Worksheets("Zufall").Cells(i2, 1).Value
ThisWorkbook.Worksheets("Senso").Cells(i2 + 5, 2).Value = ThisWorkbook.Worksheets("Zufall").Cells(i2, 2).Value
Next i2
ThisWorkbook.Worksheets("Senso").Cells(l + 5, 2).Value = Ziffer
ThisWorkbook.Worksheets("Senso").Cells(l + 5, 2).Font.Color = RGB(255, 255, 255)
ThisWorkbook.Worksheets("Senso").Cells(l + 5, 2).Interior.Color = RGB(255, 0, 0)

Call MsgBox(" * * * F E H L E R * * * " + Chr$(10) + Chr$(13) + Chr$(10) + Chr$(13) + _
"Score:" + Str(k + (l / 100)), vbOKOnly)
Call HighScore(k, l)
End
End If

DoEvents
If l = k Then
DoEvents
ThisWorkbook.Worksheets("Senso").Cells(1, 1).Select
Call Wait_A_Minute(sPauseGross)
Call CommandButtonStart_Click
End If
End Sub

Private Sub HighScore(ByVal a, b)
Dim gHighScoreTemp, gHighScore As Single

gHighScoreTemp = a + b / 100
For i = 3 To 12
gHighScore = ThisWorkbook.Worksheets("Senso").Cells(i, 13).Value

If gHighScoreTemp > gHighScore Then
If i = 3 Then
Call MsgBox("Der alte Highscore lag bei" + Str(gHighScore) + Chr$(10) + Chr$(13) + Chr$(10) + Chr$(13) + _
"Ihr neuer Highscore liegt bei" + Str(gHighScoreTemp), vbOKOnly, "Neuer Highscore ***")
Else
Call MsgBox("Ein alter Score lag bei" + Str(gHighScore) + Chr$(10) + Chr$(13) + Chr$(10) + Chr$(13) + _
"Ihr neuer Score liegt bei" + Str(gHighScoreTemp), vbOKOnly, "Neuer Score!")
End If
For j = 12 To i + 1 Step -1
ThisWorkbook.Worksheets("Senso").Cells(j, 11).Value = ThisWorkbook.Worksheets("Senso").Cells(j - 1, 11).Value
ThisWorkbook.Worksheets("Senso").Cells(j, 12).Value = ThisWorkbook.Worksheets("Senso").Cells(j - 1, 12).Value
ThisWorkbook.Worksheets("Senso").Cells(j, 13).Value = ThisWorkbook.Worksheets("Senso").Cells(j - 1, 13).Value
Next j
ThisWorkbook.Worksheets("Senso").Cells(i, 11).Value = ""
ThisWorkbook.Worksheets("Senso").Cells(i, 12).Value = Date
ThisWorkbook.Worksheets("Senso").Cells(i, 13).Value = gHighScoreTemp
ThisWorkbook.Worksheets("Senso").Cells(i, 11).Value = ThisWorkbook.Worksheets("Senso").Cells(4, .Value
Exit Sub
End If
Next i
End Sub

Private Sub ButtonBlack(ByVal index As Integer)
Select Case index
Case 1
CommandButton1.ForeColor = RGB(255, 255, 255)
CommandButton1.BackColor = RGB(0, 0, 0)
Case 2
CommandButton2.ForeColor = RGB(255, 255, 255)
CommandButton2.BackColor = RGB(0, 0, 0)
Case 3
CommandButton3.ForeColor = RGB(255, 255, 255)
CommandButton3.BackColor = RGB(0, 0, 0)
Case 4
CommandButton4.ForeColor = RGB(255, 255, 255)
CommandButton4.BackColor = RGB(0, 0, 0)
Case 5
CommandButton5.ForeColor = RGB(255, 255, 255)
CommandButton5.BackColor = RGB(0, 0, 0)
Case 6
CommandButton6.ForeColor = RGB(255, 255, 255)
CommandButton6.BackColor = RGB(0, 0, 0)
Case 7
CommandButton7.ForeColor = RGB(255, 255, 255)
CommandButton7.BackColor = RGB(0, 0, 0)
Case 8
CommandButton8.ForeColor = RGB(255, 255, 255)
CommandButton8.BackColor = RGB(0, 0, 0)
Case 9
CommandButton9.ForeColor = RGB(255, 255, 255)
CommandButton9.BackColor = RGB(0, 0, 0)
Case Else
End Select
End Sub

Private Sub ButtonColor(ByVal index As Integer)

Select Case index
Case 1
CommandButton1.ForeColor = RGB(0, 0, 0)
CommandButton1.BackColor = RGB(iFarbe_R(index), iFarbe_G(index), iFarbe_B(index))
Case 2
CommandButton2.ForeColor = RGB(0, 0, 0)
CommandButton2.BackColor = RGB(iFarbe_R(index), iFarbe_G(index), iFarbe_B(index))
Case 3
CommandButton3.ForeColor = RGB(0, 0, 0)
CommandButton3.BackColor = RGB(iFarbe_R(index), iFarbe_G(index), iFarbe_B(index))
Case 4
CommandButton4.ForeColor = RGB(0, 0, 0)
CommandButton4.BackColor = RGB(iFarbe_R(index), iFarbe_G(index), iFarbe_B(index))
Case 5
CommandButton5.ForeColor = RGB(0, 0, 0)
CommandButton5.BackColor = RGB(iFarbe_R(index), iFarbe_G(index), iFarbe_B(index))
Case 6
CommandButton6.ForeColor = RGB(0, 0, 0)
CommandButton6.BackColor = RGB(iFarbe_R(index), iFarbe_G(index), iFarbe_B(index))
Case 7
CommandButton7.ForeColor = RGB(0, 0, 0)
CommandButton7.BackColor = RGB(iFarbe_R(index), iFarbe_G(index), iFarbe_B(index))
Case 8
CommandButton8.ForeColor = RGB(0, 0, 0)
CommandButton8.BackColor = RGB(iFarbe_R(index), iFarbe_G(index), iFarbe_B(index))
Case 9
CommandButton9.ForeColor = RGB(0, 0, 0)
CommandButton9.BackColor = RGB(iFarbe_R(index), iFarbe_G(index), iFarbe_B(index))
Case Else
End Select
End Sub

Sub Wait_A_Minute(ByVal Sekunden As Single)
Dim Start, Ende

Start = Timer
Do While Timer < Start + Sekunden
DoEvents
Loop
End Sub

[eitch100]

Also 1. kopiere den Code erstmal in ein dafür vorgesehenes Code-Feld (die Raute oben beim Beitrag erstellen) sonst ist z.B. bei "8 )" immer ein "" bei dir...

Und 2. wenn du diesen Code nicht nachvollziehen kannst, solltest du dir etwas einfacheres aussuchen. Das merkt dein Lehrer sofort...

[Haseron]

Wir hatten schätzungsweise 14 Std Excel und bei den Makros/VBA sind wir vllt seit 8 Std.
Also mein Lehrer wird von dem Spiel nicht zu viel erwarten

[eitch100]

Zitat von Haseron

Nun der Schwierigkeitsgrad dieses Programms/Spiels sollte auf dem Niveau deiner schon genannten Klassiker liegen. Ich hätte mir sehr gerne Snake, Schach oder ähnliches als Spiel gewünscht, nur fehlt mir die gewisse herangehensweise an die Programmierung.

Nach 8 Std. VBA? Nimm das Zahlenraten aus Post #2 und mache es vielleicht noch ein bisschen hübscher. Selbst "Randomize" werdet ihr noch nicht gehabt haben und du willst einen Klassiker programmieren...

Du könntest z.B. den Zahlenbereich erhöhen und einen kleinen Highscore einbauen. Bei einer Änderung des Highscores lässt du Excel dann z.B. automatisch speichern. Allerdings wird dir dafür vermutlich auch einiges an Vorkenntnissen fehlen... Oder du stellst zu hohe bzw. zu niedrige Versuche in unterschiedlichen Farben dar. Versuch macht klug.

Wenn du bei solch kleineren Sachen die Syntax nicht hinbekommst, kannst du auch mal den Makrorekorder benutzen und den Code aus dem VBA-Editor unter Module versuchen in dein Projekt einzubauen...

Beispiel:
Ich habe mit dem Makrorekorder in einer Zelle die Schrift rot gemacht...

Sub Makro1()
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
End Sub

Wenn ich jetzt alle Eingaben, die zu klein sind, in rot haben möchte, würde das in dem entspechenden Teil des Codes so aussehen...

    If i > a Then
    MsgBox "Grösser"

    With Cells(n, 1)
        .Value = "Versuch " & n & " war " & a & ", die Lösung ist größer."
        .Font.Color = -16776961
        .Font.TintAndShade = 0
    End With
   
    End If

ohne With... End With...

    If i > a Then
    MsgBox "Grösser"

    Cells(n, 1).Value = "Versuch " & n & " war " & a & ", die Lösung ist größer."
    Cells(n, 1).Font.Color = -16776961
    
    End If

Allerdings muss weiter oben ClearContents auf Clear geändert werden, weil sonst nur die Zellinhalte und nicht deren Formatierung gelöscht wird...

[Haseron]

Danke für eure, vorallem durch eitch100 Hilfe!!! Ihr helft mir wirklich extrem, mein Problem war halt dass das Projekt wie eine Klausur gewertet wird und ich dachte ich müsste jetzt sonst was hinzaubern.
Also soll ich den Code aus #2 nehmen und en erweitern mit den von dir gennanten Code?

[Haseron]

Der Code, bzw das Programm läuft in Endlosschleife wie könnte ich das beenden :/? also es gibt undendlich versuche kann aber auch nicht beendet werden.

[eitch100]

Also du "sollst" das jetzt nicht zwingend tun. Euer Lehrer hat euch eine Aufgabe gestellt, die ihr im Rahmen eurer Möglichkeiten umsetzen solltet. Wärst du gleich am Anfang damit rausgerückt, auf welchen Level ihr seid, hätten wir bzw. hättest du viel Zeit sparen können. Das Zahlenratespiel, was ich eigentlich nur mal so als kleines Beispiel in den Raum geworfen habe, war ja letztlich anscheinend schon etwas zu weitreichend.

Dieses Forum dient nicht dazu irgendwem die Hausaufgaben abzunehmen. Also versuche nun das Beste daraus zu machen... Wenn du dann Probleme mit der Umsetzung hast, wird dir hier bestimmt geholfen, ber den ersten Schritt musst du selbst tun...

Edit: ups... crossposting... poste den Code... normalerweise müsste das Programm durch die "exit sub" Anweisung das Programm beenden, wenn die richtige Lösung eingegeben wurde...

[Haseron]

Ja ist mir schon klar das ich das alleine machen sollte ^^ ich will mir auch nicht die arbeit von euch abnehmen lassen, ich hab nur ergänzene Fragen zum Quellcode, da ich mich schon grad sehr bemühe alles selber zu machen ^^ nur werde ich nicht fündig im internet zu deiner recht guten idee einen highscore einzufügen. Vielleicht wärst du ja nochmal so nett und würdest mir einen Tipp. Ich weiß wie man das in einer normalen tabelle wieder gibt aber nciht wie die rangliste die daten speichert und einträgt.

[eitch100]

Also heute Abend wird das nichts mehr... Sorry... und wenn du es morgen abgeben musst, beschränke dich einfach auf ein paar Schönheitsmaßnahmen... Mach nen hübschen CommandButton und ein bisschen Hinweistext und gut ist...

[Haseron]

Egal ich gib mein bestesn aber danke aufjedenfall für deine Hilfe!!!! Schönen Abend dir noch

[Haseron]

Achja hier der Code ^^

Sub Makro1()

Dim i As Integer
Dim n

n = 1
[A:A].ClearContents
Randomize
i = Int((100 - 0 + 1) * Rnd + 0)
    
    If i > a Then
    MsgBox "Grösser"

    With Cells(n, 1)
        .Value = "Versuch " & n & " war " & a & ", die Lösung ist größer."
        .Font.Color = -16776961
        .Font.TintAndShade = 0
    End With
   
    End If

Do

a = InputBox("Bitte raten.")
    
    If i > a Then
    MsgBox "Grösser"
    Cells(n, 1).Value = "Versuch " & n & " war " & a & ", die Lösung ist größer."
    End If
    
    If i < a Then
    MsgBox "Kleiner"
    Cells(n, 1).Value = "Versuch " & n & " war " & a & ", die Lösung ist kleiner."
    End If
    
    If i = a Then
    MsgBox "Gewonnen"
    Cells(n, 1).Value = a & " ist richtig! Das waren " & n & " Versuche."
    Exit Sub 'Damit es keine Endlosschleife wird
    End If
 
    n = n + 1
    
Loop

End Sub

[eitch100]

Du hast den Code zum Verändern der Farbe einfach irgendwo in den Originalcode hineinkopiert. Du hättest den Originalcode mit dem neuen ersetzen müssen... Also der unten rot markierte muss raus und dahin, wo er grün markiert ist... Sowas könntest du dann für zu große Versuche und die richtige Lösung in anderen Farben auch noch machen... Und aus ClearContents muss noch Clear werden.

Sub Makro1()

Dim i As Integer
Dim n

n = 1
[A:A].Clear 'Contents
Randomize
i = Int((100 - 0 + 1) * Rnd + 0)
    
    If i > a Then
    MsgBox "Grösser"

   With Cells(n, 1)
        .Value = "Versuch " & n & " war " & a & ", die Lösung ist größer."
        .Font.Color = -16776961
        .Font.TintAndShade = 0
    End With
   
    End If

Do

a = InputBox("Bitte raten.")
    
    If i > a Then
    MsgBox "Grösser"

   With Cells(n, 1)
        .Value = "Versuch " & n & " war " & a & ", die Lösung ist größer."
        .Font.Color = -16776961
        .Font.TintAndShade = 0
    End With
   
    End If
    
    If i < a Then
    MsgBox "Kleiner"
    Cells(n, 1).Value = "Versuch " & n & " war " & a & ", die Lösung ist kleiner."
    End If
    
    If i = a Then
    MsgBox "Gewonnen"
    Cells(n, 1).Value = a & " ist richtig! Das waren " & n & " Versuche."
    Exit Sub 'Damit es keine Endlosschleife wird
    End If
 
    n = n + 1
    
Loop

End Sub

[wolfgang_pauli]

Realsatire pur ... wenn jemand so ein fauler loser ist und sich Null Mühe gibt würde ich ihn voll hängen lassen