Zufallszeichen an Zufallsposition ersetzen

Zugegeben, das hört sich etwas kryp­tisch an, was da in der Über­schrift ste­ht. Aber dort sind nun ein­mal kurze, knack­ige Texte gefragt. Gemeint ist fol­gen­des: Eine Zelle enthält einen beliebi­gen Text, genauer gesagt ein Wort. In diesem Wort soll an beliebiger, zufäl­lig bes­timmter Posi­tion ein Zeichen durch ein wiederum zufäl­lig gewähltes anderes Zeichen erset­zt wer­den. Die Groß- Klein­schrei­bung soll erhal­ten bleiben und es sollen alle Buch­staben des deutschen Alpha­bets genutzt wer­den.

Wir bieten Ihnen hier eine kleine VBA-Lösung an, die das gut löst. Voraus­set­zung ist, dass wirk­lich nur das eine Wort ohne Satzze­ichen in der Zelle ste­ht. Ein Dop­pelk­lick auf die Zelle wird sofort ein beliebiges/zufälliges Zeichen ändern:

Option Explicit
Option Base 1

Sub WorkSheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   Dim Lg As Integer, Pos As Integer, Zeichen As String, Ersatz As String
   Dim aUcase(29), aLcase(30)
   Dim i As Integer
   
   If VarType(Target) > 8 Then
      'Eventuell eine Fehlermeldung, dass es kein Text ist ...
      Cancel = True
      Exit Sub
   End If
   
   'Arrays mit Buchstaben füllen
   For i = 65 To 90
      aUcase(i - 64) = Chr(i)
   Next i
   aUcase(27) = "Ä"
   aUcase(28) = "Ö"
   aUcase(29) = "Ü"
   For i = 97 To 122
      aLcase(i - 96) = Chr(i)
   Next i
   aLcase(27) = "ä"
   aLcase(28) = "ö"
   aLcase(29) = "ü"
   aLcase(30) = "ß"
   
   'Und ersetzen
   Lg = Len(Target)
   Pos = WorksheetFunction.RandBetween(1, Lg)
   Zeichen = Mid(Target, Pos, 1)
   If Zeichen = UCase(Zeichen) Then 'Großbuchstaben ersetzen
      Do While True
         Ersatz = aUcase(WorksheetFunction.RandBetween(1, 29))
         If Ersatz > Zeichen Then Exit Do
      Loop
   Else  'Kleinbuchstaben
      Do While True
         Ersatz = aLcase(WorksheetFunction.RandBetween(1, 30))
         If Ersatz > Zeichen Then Exit Do
      Loop
   End If
   Target = Left(Target, Pos - 1) & Ersatz & Right(Target, Lg - Pos)
   Cancel = True
End Sub

Hin­weis: Führende oder nachgestellte Leerze­ichen wer­den hier nicht abge­fan­gen, sie wer­den als ganz nor­male Zeichen gew­ertet und bei entsprechen­der Posi­tion mit einem Zeichen des Alpha­bets erset­zt.

Mit etwas Pro­gram­mi­er-Erfahrung kön­nen Sie den Code auch so umän­dern, dass das Erset­zen in allen Zellen eines definierten Bere­ichs bzw. ein­er Markierung erfol­gt.