Willkommen

Pivottabelle

Spezialfilter

Formeln

Zellformate

Bedingte Formate

Gültigkeit

Programmierung

UDF - Funktionen

Tipps & Tricks

Webabfrage

Fehlersuche

Farbindex

Shortcuts

Limitationen

Downloads

Links

Kontakt

Disclaimer

Impressum

Buchstaben innerhalb eines Wortes mischen
Benutzerdefinierte Funktion
 
Hier eine ausgefallene Funktion, welche in einem längeren Satz den ersten und letzten Buchstaben eines Wortes an der Ursprungspositon belässt, die Buchstaben innerhalb des Wortes aber mischt.
Trotzdem sind wir in der Lage, einen solchen Satz noch zu lesen.
Den Code habe ich freundlicherweise von Ransi für meine HP bekommen habe.
 
 
Tabelle1
 A
1Ich weiß zwar noch nicht, wie ich das anstellen soll, aber ich suche nach einer Möglichkeit einen beliebig langen Satz so zu bearbeiten, dass immer nur der erste und letzte Buchstabe des Wortes bestehen bleibt. Die Buchstaben in der Mitte eines Wortes sollen wild durcheinander gewürfelt werden.
2Ich wieß zawr ncoh nhcit, wie ich das aetnllesn slol, aebr ich schue ncah eeinr Milikchöget eienn bileeibg lgaenn Staz so zu bebaieretn, dsas imemr nur der etrse und lettze Bhsutcbae des Woters beetshen bbliet. Die Bbsaeuhtcn in der Mttie eiens Wertos sellon wlid dderahnceuinr gwlerfüet wdeern.
Formeln der Tabelle
A2 : =aufruf(A1)
 
Diagramm - Grafik - Excel Tabellen einfach im Web darstellen    Excel Jeanie HTML  3.0    Download  
 
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