Hallo Rätselinteressierte,
jetzt wird der BF-Code fehlerlos in Vba-Code umgesetzt.
Naja, der fertige Code klappt noch nicht, eher gar nicht.
Mal landet er in einer Endlosschleife, mal (Eingaben 1 2 3 4 5) nicht.
Das liegt jetzt aber mit auch daran daß ich nicht genau weiß wie ich die Eingabe eines Zeichens umsetzen soll, anschließend die Ausgabe.
Geschweige denn wie ich dann herausfinde wie die Eingaben aussehen müssen daß am Ende "Correct" erscheint und nicht "Wrong"
Hat jmd. da noch Ideen? Mir gehen sie langsam aus :-(
Hier die Datei: https://www.herber.de/bbs/user/57893.xls
Nachfolgend mein Cde zur Erstellung des BF-Codes.
Danke ^ Gruß
Reinhard
Die Prozedur Brainfuck erwartet den BF-Code in Tabelle4!A1, ggfs. anpassen.
Hier der BF-Code:
>++++++++++[-]++++++[-].>++[-].>+++[-]+++[-]+++[-].>++[-].>++++[-]++++[-]>++++++++++[-]>++++++++++[-]>++++++++++[-]>+++++++++++[-],.++>,.>,.>,.---->,.>>>++++++++[-]>++++++++++[-]>+++++++++++[-]>+++++++++++[-]>+++++++++++[-]>++++++++++[-]>++++++[-]+>>++++++++[-]>++++++++++[-]>+++++++++++[-]>+++++++++++[-]>+++++++++++[-]>++++++++++[-]>++++++++++[-]>+++++++++++[-]>++++++[-]>>>>-]>>>>>>>>>+>>>>>-[>>>>-]>>>>>>>>+>>>>>++[>>>>-]>>>>>>>+>>>>>[>>>>-]>>>>>>+>>>>>+++++[>>>>-]>>>>>+>>>>>[>.>.>.>.>.>.>.>->>>>>>>[>.>.>.>.>.>.>.>.>.
Option Explicit
Public P() As String, Anz As Long, Einr As Byte
Sub Brainfuck()
Dim strOok As String, N As Long, Zei As Long, wks As Worksheet
ReDim P(3)
Set wks = Worksheets("Tabelle4") 'Anpassen
P(0) = "Sub Brainfuck()"
P(1) = "Dim Ausgabe As String"
P(2) = "Worksheets.Add"
P(3) = "Cells(1, Columns.Count / 2).Select"
Anz = 3
Zei = 8
With wks
.Range("A3:D2000").ClearContents
strOok = .Range("A1") 'Anpassen
For N = 1 To Len(strOok)
Call Check2(Mid(strOok, N, 1))
Next N
For N = 1 To Len(strOok)
.Cells(Zei, 2) = Mid(strOok, N, 1)
While Mid(strOok, N, 1) = Mid(strOok, N + 1, 1) And Mid(strOok, N, 1) "]"
.Cells(Zei, 2) = .Cells(Zei, 2) & Mid(strOok, N, 1)
N = N + 1
Wend
Zei = Zei + 1
Next N
Anz = Anz + 2
ReDim Preserve P(Anz)
P(Anz - 1) = "Msgbox Ausgabe"
P(Anz) = "End Sub"
For N = 0 To Anz
.Cells(N + 4, 1) = P(N)
Next N
End With
End Sub
Sub Check2(ByVal Zeichen As String)
Dim Z As Integer
Const strPlus As String = "ActiveCell.Value = ActiveCell.Value + "
Const strMinus As String = "ActiveCell.Value = ActiveCell.Value - "
Const strRechts As String = "ActiveCell.Offset(0, "
Const strLinks As String = "ActiveCell.Offset(0, -"
Select Case Zeichen
Case "+" 'den Wert der aktuellen Zelle um 1 erhöhen
If InStr(P(Anz), strPlus) > 0 Then
P(Anz) = String(Einr, " ") & strPlus & CInt(Mid(P(Anz), Len(strPlus) + 1)) + 1
Else
Anz = Anz + 1
ReDim Preserve P(Anz)
P(Anz) = String(Einr, " ") & strPlus & 1
End If
Case "-" 'den Wert der aktuellen Zelle um 1 verringern
If InStr(P(Anz), strMinus) > 0 Then
P(Anz) = String(Einr, " ") & strMinus & CInt(Mid(P(Anz), Len(strMinus) + 1)) + 1
Else
Anz = Anz + 1
ReDim Preserve P(Anz)
P(Anz) = String(Einr, " ") & "ActiveCell.Value = ActiveCell.Value - 1"
End If
Case ">" 'eine Zelle nach rechts gehen
If InStr(P(Anz), strRechts) > 0 And InStr(P(Anz), strLinks) = 0 Then
Z = CInt(Replace(Replace(P(Anz), String(Einr, " ") & strRechts, ""), ").Select", "")) + _
1
P(Anz) = String(Einr, " ") & strRechts & Z & ").Select"
Else
Anz = Anz + 1
ReDim Preserve P(Anz)
P(Anz) = String(Einr, " ") & "ActiveCell.Offset(0, 1).Select"
End If
Case " 0 Then
Z = CInt(Replace(Replace(P(Anz), String(Einr, " ") & strLinks, ""), ").Select", "")) + _
1
P(Anz) = String(Einr, " ") & strLinks & Z & ").Select"
Else
Anz = Anz + 1
ReDim Preserve P(Anz)
P(Anz) = String(Einr, " ") & "ActiveCell.Offset(0, -1).Select"
End If
Case "[" 'Schleifenanfang - die Schleife durchlaufen solange der Wert der aktuellen Zelle _
ungleich 0 ist
Anz = Anz + 1
ReDim Preserve P(Anz)
P(Anz) = String(Einr, " ") & "While Activecell 0"
Einr = Einr + 3
Case "]" 'Schleifenende - beendet die Schleife, wenn der Wert der aktuellen Zelle gleich 0 _
ist
Einr = Einr - 3
Anz = Anz + 1
ReDim Preserve P(Anz)
P(Anz) = String(Einr, " ") & "Wend"
Case "." 'den Wert der aktuellen Zelle ausdrucken
Anz = Anz + 1
ReDim Preserve P(Anz)
P(Anz) = String(Einr, " ") & "Ausgabe = Ausgabe & ActiveCell.value"
Case "," 'einen Wert von der Tastatur in die aktuelle Zelle einlesen
Anz = Anz + 1
ReDim Preserve P(Anz)
P(Anz) = String(Einr, " ") & "Activecell.Value = Asc(Inputbox(""Ein Zeichen eingeben""))"
Case Else
MsgBox "Fehler bei Zeichen " & Zeichen
End Select
End Sub