Wordle (ähnlich Mastermind) + gleiche Buchstaben

KlausF · 2024-07-23T15:53:52+00:00

Hallo Forum, ich bräuchte mal einen Input zu dem Spiel Wordle, das ich gerne für mich der grauen Zellen wegen mit VBA programmieren möchte. Hier kurz die einfachen Regeln, für die, die es nicht kennen: - Es gilt ein Wort mit 5 Buchstaben in maximal 6 Versuchen herauszufinden. - Ein nicht vorhandener Buchstabe wird mit grauem Feld, ein richtig platzierter Buchstabe mit grün unterlegtem Feld und ein vorhandener aber falsch platzierter Buchstabe mit gelbem Feld angezeigt. Ich habe das mit 2 Schleifen abgearbeitet, was auch gut funktioniert aber leider nicht zu Ende gedacht. Mein Problem: Kommt ein Buchstabe - z.B. B - im Lösungswort nur 1 x vor aber im Lösungsversuch mehr als 1 x, dann werden alle B im Lösungsversuch mit gelb bzw. grün hinterlegt Wie lässt sich das am Besten lösen? Komme ich da überhaupt mit meinen Schleifen weiter oder braucht es da einen komplett anderen Ansatz? 171190.xlsm Danke für jeden Input im voraus! Gruß Klaus

Moin Klaus!

Nicht gleich eingeschnappt sein. ;-)

Ist nur nicht ganz einfach einen Lösungsweg zu zeigen ohne die Lösung zu zeigen.
Du hast aber schon genug gelernt, wenn du verstehst was gemacht wird.

Daher schreib ich jetzt auch keine Erklärung für den Code.
Selbst herausfinden darfst du auch , wie eine Eingabe direkt bei Eingabe überprüft wird und wie man zufällig aus der Langen Liste der Worte selbst eines auswählt, ohne sie mühsam in 5 Felder zu schreiben.
Nur so viel: Zufällig eine Zeile im Bereich generieren und die bis zur Lösung in eine Zelle schreiben. Darauf während der Überprüfung referenzieren. L_Wort = sheets(2).cells(Zeile,1)

Hier noch der Code

Sub Vergleich()

    Dim x As Single

    Dim sp As Single

    Dim pos As Single

    Dim L_Wort As String

    For x = 3 To 7

        L_Wort = L_Wort & Cells(14, x)

    Next x

    

    Range("Wort1").Interior.Color = RGB(128, 128, 128)

    

    For sp = 1 To 5

        If Cells(5, sp + 2).Value = Mid(L_Wort, sp, 1) Then

            Cells(5, sp + 2).Interior.Color = RGB(57, 215, 87) 'Grün

            Select Case sp

                Case 1: L_Wort = "_" & Right(L_Wort, 4)

                Case 5: L_Wort = Left(L_Wort, 4) & "_"

                Case Else:  L_Wort = Left(L_Wort, sp) & "_" & Right(L_Wort, 6 - sp)

            End Select

            

        ElseIf InStr(L_Wort, Cells(5, sp + 2).Value) > 0 Then

            Cells(5, sp + 2).Interior.Color = RGB(255, 204, 0) 'Gelb

            

            pos = InStr(L_Wort, Cells(5, sp + 2).Value)

            Select Case pos

                Case 1: L_Wort = "_" & Right(L_Wort, 4)

                Case 5: L_Wort = Left(L_Wort, 4) & "_"

                Case Else:  L_Wort = Left(L_Wort, pos - 1) & "_" & Mid(L_Wort, pos + 1, 5)

            End Select

        End If

    Next sp



End Sub

Ich habe das auch nicht wirklich zu Ende gedacht, das war ja eigentlich deine Aufgabe.
Aber hab halt doch auch ein bisschen Code gebaut, wobei ich dein "Rechteck 7" in "Rechteck 1" umgetauft habe....
ja und allen den Rechtecken das gleiche Makro zugewiesen habe...
Kannst ja mal schauen, ob es das tut....



Sub Zeigen_1()



    Dim strCaller As String

    Dim strTipp As String

    Dim strSuchwort As String

    Dim lngLineOffset As Long

    Dim wksSpiel As Worksheet

    Dim rngSpiel As Range

    Dim i As Long, j As Long, lngPos As Long

    

    strCaller = Application.Caller

    

    lngLineOffset = Val(Right(strCaller, 1)) - 1

        

    Set wksSpiel = ThisWorkbook.Worksheets("Spiel")

    Set rngSpiel = wksSpiel.Range("C4")

    

    'Strings mit Tipp und Suchwort belegen

    For i = 0 To 4

        strTipp = strTipp & IIf(IsEmpty(rngSpiel.Offset(lngLineOffset, i)), " ", Left(rngSpiel.Offset(lngLineOffset, i), 1))

        strSuchwort = strSuchwort & wksSpiel.Range("C14").Offset(0, i)

    Next

        

    'Prüfen auf richtiger Buchstabe auf richtiger Position (ggf. grün)

    For i = 4 To 0 Step -1

        If Mid(strTipp, i + 1, 1) = Mid(strSuchwort, i + 1, 1) Then

            rngSpiel.Offset(lngLineOffset, i).Interior.Color = RGB(57, 215, 87)

            strSuchwort = Left(strSuchwort, i) & Right(strSuchwort, Len(strSuchwort) - i - 1)

            strTipp = Left(strTipp, i) & " " & Right(strTipp, 4 - i)

        Else

            rngSpiel.Offset(lngLineOffset, i).Interior.Color = RGB(128, 128, 128)

        End If

    Next

    

    If Len(strSuchwort) > 0 Then

        'noch nicht gelöst, prüfen auf richtige Buchstaben (ggf. gelb)

        For i = 0 To 4

            lngPos = InStr(1, strSuchwort, Mid(strTipp, i + 1, 1), vbTextCompare)

            If lngPos > 0 Then

                strSuchwort = Left(strSuchwort, lngPos - 1) & Right(strSuchwort, Len(strSuchwort) - lngPos)

                rngSpiel.Offset(lngLineOffset, i).Interior.Color = RGB(255, 204, 0)

            End If

            If strSuchwort = "" Then Exit For

        Next

    End If



End Sub

Wordle (ähnlich Mastermind) + gleiche Buchstaben

Forumthread: Wordle (ähnlich Mastermind) + gleiche Buchstaben

18
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Wordle (ähnlich Mastermind) + gleiche Buchstaben

Forumthread: Wordle (ähnlich Mastermind) + gleiche Buchstaben

18 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

18
Beiträge zum Forumthread

Beiträge zu diesem Forumthread