Mélanger les carac des mots tout en laissant la première/dernière lettre

Bonjour,

Voici le titre en version longue : Mélanger les caractères des mots tout en laissant la première/dernière lettre

En fait, j'ai une colonne dans mon fichier, avec des phrases pour chaque ligne, et mon besoin serait de changer en sein de cette même cellule le texte de cette manière (un exemple) :

Bonjour c'est le forumBojounr ce'st le froum
Hier était un autre jour
Hier éiatt un atrue jour

Si un mot de 4/5 caractères n'est pas mélangé, ce n'est pas grave. C'est, plus il est long, plus il doit être mélangé.

Merci à vous si vous avez des idées ;)

bonjour,

une proposition via une fonction personnalisée, le séparateur de mots étant l'espace.

Function scramble$(texte$)
    Dim i&, j&, st$, bs&, a&, b&, c$, s
    With Application.WorksheetFunction
        Randomize
        s = Split(texte, " ")
        For i = LBound(s) To UBound(s)
            st = s(i)
            bs = Len(st) - 1
            If bs > 2 Then
                Do
                    For j = 1 To bs
                        a = .RandBetween(2, bs)
                        b = .RandBetween(2, bs)
                        c = Mid(st, a, 1)
                        Mid(st, a, 1) = Mid(st, b, 1)
                        Mid(st, b, 1) = c
                    Next j
                Loop While st = s(i)
                s(i) = st
            End If
        Next i
        scramble = Join(s, " ")
    End With
End Function

à mettre dans un nouveau module vba et à utiliser en excel comme une fonction standard excel (exemple pour un texte en A1)

=scramble(A1)

Bonjour à tous

Une proposition PowerQuery

Chaque actualisation change le mélange

Bonjour,

Merci pour vos deux retours.

Alors la fonction, c'est parfait, sauf que le mot "Elles", le fait planter :/
Je sais pas s'il y a d'autre mot ou non.

Le PowerQuery c'est pas mal aussi.

bonjour,

une correction pour le cas "elle"

Function scramble$(texte$)
    Dim i&, j&, st$, bs&, a&, b&, c$, s, ctr&
    With Application.WorksheetFunction
        Randomize
        s = Split(texte, " ")
        For i = LBound(s) To UBound(s)
            st = s(i)
            bs = Len(st) - 1
            If bs > 2 Then
            ctr = 1
                Do
                    For j = 1 To bs
                        a = .RandBetween(2, bs)
                        b = .RandBetween(2, bs)
                        c = Mid(st, a, 1)
                        Mid(st, a, 1) = Mid(st, b, 1)
                        Mid(st, b, 1) = c
                    Next j
                    ctr = ctr + 1
                Loop While st = s(i) And ctr < 10
                s(i) = st
            End If
        Next i
        scramble = Join(s, " ")
    End With
End Function

Super !

Merci à vous deux de votre réactivité !

Rechercher des sujets similaires à "melanger carac mots tout laissant premiere derniere lettre"