Wort- und Satzmanipulation

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub wort_mischen() Dim iLen As Integer, varArr(), varTemp, iZ As Integer, strS As String, strMix As String strS = "BLUME" Randomize Timer ReDim varArr(Len(strS)) For iLen = 1 To Len(strS) varArr(iLen) = Mid(strS, iLen, 1) Next iLen For iLen = Len(strS) To 1 Step -1 iZ = Int((iLen * Rnd) + 1) varTemp = varArr(iZ) varArr(iZ) = varArr(iLen) varArr(iLen) = varTemp Next iLen For iLen = 1 To Len(strS) strMix = strMix & varArr(iLen) Next MsgBox strMix End Sub

Private Sub zufallsreihenfolge() Dim wort As String Dim laenge As Integer Dim zahl As Integer Dim buchstabe As String Dim zwischenspeicher As String Dim satz(100) As String Randomize Timer wort = Cells(1, 1) laenge = Len(wort) 'nur ein wort If InStr(1, wort, " ") = 0 Then Do While Len(zwischenspeicher) <> laenge zahl = Int((laenge * Rnd) + 1) buchstabe = Mid(wort, zahl, 1) If buchstabe <> "+" Then zwischenspeicher = zwischenspeicher & buchstabe Mid(wort, zahl, 1) = "+" End If Loop Cells(1, 2) = UCase(zwischenspeicher) Else 'ein satz Do While InStr(1, wort, " ") <> 0 satz(i) = Left(wort, InStr(1, wort, " ") - 1) wort = Right(wort, Len(wort) - 1 - Len(satz(i))) i = i + 1 Loop satz(i) = wort Do While i <> 0 zahl = Int((i * Rnd) + 1) If satz(zahl) <> "+" Then zwischenspeicher = zwischenspeicher & " " & satz(i) satz(i) = "+" i = i - 1 End If Loop zwischenspeicher = zwischenspeicher & " " & satz(i) Cells(1, 2) = LTrim(zwischenspeicher) End If End Sub

Hallo Hajo,
gibt zwar schon Lösungen, aber da ich auch mal ne Lösung gemacht habe für beides, häng ich die einfach mal an:


Sub TuchstabenVerbauchen()
Dim s$, strNeu$, i%, j%
Randomize
s = "MATERIE"
While Not s = ""
i = Len(s)
j = Int(i * Rnd + 1)
strNeu = strNeu & Mid(s, j, 1)
s = Left(s, j - 1) & Right(s, i - j)
Wend
MsgBox strNeu
End Sub


Sub VertauschenWoerter()
Dim s$, strNeu$, i%, j%, intZufall%, h%
Dim arrWoerter() As String
Randomize
s = "Die Maus frisst Käse."
i = 0
j = InStr(s, " ")
While Not j = 0
ReDim Preserve arrWoerter(i + 1)
arrWoerter(i) = Left(s, j - 1)
s = Right(s, Len(s) - j)
j = InStr(s, " ")
i = i + 1
If j = 0 Then arrWoerter(i) = s
Wend
For j = i To 0 Step -1
intZufall = Int((j + 1) * Rnd)
strNeu = LTrim(strNeu) & " " & arrWoerter(intZufall)
For h = intZufall To i - 1
arrWoerter(h) = arrWoerter(h + 1)
Next h
Next j
MsgBox strNeu
End Sub

Hoffe das hilft weiter,
Andreas

Na dann will ich doch gleich mein Problem versuchen zu schildern!
Hier mein Problem: Ihr kennt doch alle das Symbolzahlenrätsel aus Rätselzeitschriften?
Da wird eine Rechenaufgabe durch Symbole dargestellt, und man muss dann durch logisches Nachdenken und Kombinieren herausfinden, welche Zahl welches Symbol bedeutet. Solch ein Symbolrätsel hätte ich gern mit einfachsten kleinen Bildchen (Tierbildchen / Blumenbilchen usw.) mit Excel gemacht. Verstanden? wenn nicht mache ich ein Beispiel:
8 8 + 7 1 2 = 8 0 0
Die 1 ist z.B. ein Affe, die 2 eine Biene, die 7 ein Hase, die Null ein Schmetterling.
Nun muss man probieren und rechnen um auf die Lösung zu kommen.
Excel könnte dann noch anzeigen, ob ich richtig gerechnet habe (aber das dürfte ja nicht schwierig sein?)
geht das mit Formeln oder braucht man dazu VBA?
Gruß Hajo

Beliebteste Forumthreads (12 Monate)

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread