Damit die Formel genutzt werden kann, muss der unten genannte Code in ein "Allgemeines Modul". ( Siehe auch UDF - Funktionen
-> * Allgemeines Modul - Kurzanleitung * )
Der Code:
Public Function Aufruf(zelle) As String
'*************************************
'Autor: Ransi
'*************************************
Dim S As String
Dim objRegex As Object
Dim WortListe As Object
Dim Wort As Object
S = zelle.Text
Set objRegex = CreateObject("Vbscript.Regexp")
With objRegex
.Pattern = "[A-Za-zäöüßÄÖÜ]+"
.Global = True
Set WortListe = .Execute(S)
For Each Wort In WortListe
Mid(S, Wort.firstindex + 1, Len(Wort)) = mischen(Wort)
Next
End With
Aufruf = S
End Function
Public Function mischen(strS) As String
Dim Arr As Variant
Dim I As Integer
Dim ZZ As Integer
Dim tmp As String
If Len(strS) <= 3 Then
mischen = strS
Exit Function
End If
Randomize Timer
ReDim Arr(0 To Len(strS) - 3)
For I = 2 To Len(strS) - 1 'Alle Buchstaben des Wortes(bis auf den ersten und letzten)in ein Array.
Arr(I - 2) = Mid(strS, I, 1)
Next
For I = 0 To UBound(Arr) 'Das Array mal kurz schütteln...
ZZ = Int(UBound(Arr) * Rnd)
tmp = Arr(ZZ)
Arr(ZZ) = Arr(I)
Arr(I) = tmp
Next
mischen = Left(strS, 1) & Join(Arr, "") & Right(strS, 1) 'Den ersten Buchstaben & das geschüttelte Array & den letzten Buchstaben
End Function
|
|||||||||||||||||
