Menu
Donnez votre avis

VBA Mélanger les caractères d'une chaîne

Posez votre question


Liminaire

Le but de l'astuce est d'apprendre à mélanger n'importe quel array.
L'exercice choisit est de mélanger les lettres d'un mot et d'en obtenir un "score". Le score étant le nombre de lettres qui restent en place à la fin du mélange.

Code d'appel

Option Explicit

Sub Melange()
Dim W, S() As Long
Dim A$, C&, i As Integer
Dim B As Byte, Bo As Boolean, L As Byte

    W = Array("a", "abracadabra", "seesaw", "elk", "grrrrrr", "up", "azerty", "tttt")
    For B = 0 To UBound(W)
        C = 0
        Select Case Len(W(B))
            Case 1: L = 1
            Case Else
                i = NbLettresDiff(W(B))
                If i >= Len(W(B)) \ 2 Then
                    L = 0
                ElseIf i = 1 Then
                    L = Len(W(B))
                Else
                    L = Len(W(B)) - i
                End If
        End Select
Recommence:
        Do
            S() = MelangeIndicesTab(Len(W(B)))
            Bo = BonMelange(S, L)
        Loop While Not Bo
        A = MelangeLeMot(CStr(W(B)), S)
        C = Verifie(W(B), A)
        If C > L Then GoTo Recommence
        Debug.Print W(B) & " ==> " & A & " (Score : " & C & ")"
    Next
End Sub

Les fonctions utilisées

Mélange les indices d'un tableau

Cette fonction créée une variable tableau, de type Long, contenant des indices mélangés.
Exemple : MelangeIndicesTab(3) peut me sortir :
MelangeIndicesTab(0) = 2
MelangeIndicesTab(1) = 1
MelangeIndicesTab(2) = 3
MelangeIndicesTab(3) = 0


Function MelangeIndicesTab(L As Long) As Long()
Dim i As Integer, j As Integer, temp() As Long
Dim C As New Collection

    ReDim temp(L - 1)
    If L = 1 Then
        temp(0) = 0
    ElseIf L = 2 Then
        temp(0) = 1: temp(1) = 0
    Else
        Randomize
        Do
            j = Int(Rnd * L)
            On Error Resume Next
            C.Add CStr(j), CStr(j)
            If Err <> 0 Then
                On Error GoTo 0
            Else
                temp(j) = i
                i = i + 1
            End If
        Loop While C.Count <> L
    End If
    MelangeIndicesTab = temp
End Function

Fonction de vérification du tableau

Cette fonction vérifie si la variable tableau créée précédemment est bien mélangée.

Function BonMelange(t() As Long, Lim As Byte) As Boolean
Dim i&, C&
    
    For i = LBound(t) To UBound(t)
        If t(i) = i Then C = C + 1
    Next i
    BonMelange = (C <= Lim)
End Function

Fonction de mélange des caractères

Function MelangeLeMot(W$, S() As Long) As String
Dim i&, temp, strR$

    temp = Split(StrConv(W, vbUnicode), Chr(0))
    For i = 0 To UBound(S)
        strR = strR & temp(S(i))
    Next i
    MelangeLeMot = strR
End Function

Nombre de lettres communes à deux chaînes

Function Verifie(W, A) As Integer
Dim i As Integer, L As Integer

    For i = 1 To Len(W)
        If Mid(W, i, 1) = Mid(A, i, 1) Then L = L + 1
    Next i
    Verifie = L
End Function

Nombre de lettres différentes dans une chaîne

Function NbLettresDiff(W) As Integer
Dim i&, C As New Collection
    For i = 1 To Len(W)
        On Error Resume Next
        C.Add Mid(W, i, 1), Mid(W, i, 1)
    Next i
    NbLettresDiff = C.Count
End Function
Jean-François Pillou

Cet article est régulièrement mis à jour par des experts sous la direction de Jean-François Pillou, fondateur de CommentCaMarche et directeur délégué au développement numérique du groupe Figaro.

En savoir plus sur l'équipe CCM

Publié par pijaku. Dernière mise à jour le 25 octobre 2017 à 08:29 par pijaku.

Ce document intitulé «  VBA Mélanger les caractères d'une chaîne  » issu de CommentCaMarche (https://www.commentcamarche.net/) est mis à disposition sous les termes de la licence Creative Commons. Vous pouvez copier, modifier des copies de cette page, dans les conditions fixées par la licence, tant que cette note apparaît clairement.

Ajouter un commentaire

Commentaires

Commenter la réponse de Utilisateur anonyme