Menu

VBA: como misturar os caracteres de uma cadeia

Última modificação: por Ana Spadari .

O objetivo desta dica é mostrar como misturar qualquer matriz. O exercício escolhido é misturar as letras de uma palavra e obter uma pontuação. A pontuação é o número de letras que permanece no lugar no final da mistura.

Código de chamada

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
Recomece:
        Do
            S() = MisturaíndicesTab(Len(W(B)))
            Bo = Boamistura(S, L)
        Loop While Not Bo
        A = MisturaAPalavra(CStr(W(B)), S)
        C = Verifique(W(B), A)
        If C > L Then GoTo Recomece
        Debug.Print W(B) & " ==> " & A & " (Score : " & C & ")"
    Next
End Sub

Quais são as funções usadas

Misturar os Índices de uma tabela

Esta função cria uma variável tabela, do tipo longo, contendo Índices misturados.
Exemplo: MisturaíncicesTab(3) pode me tirar:
MisturaíncicesTab(0) = 2
MisturaíncicesTab(1) = 1
MisturaíncicesTab(2) = 3
MisturaíncicesTab(3) = 0

Function MisturaíncicesTab(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
    MisturaíncicesTab= temp
End Function

Função de verificação da tabela

Esta função verifica se a varável tabela criada anteriormente foi bem misturada.

Function Boamistura(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
    Boamistura = (C <= Lim)
End Function

Função de mistura dos caracteres

Function MisturaAPalavra(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
    MisturaAPalavra = strR
End Function

Número de letras comuns às duas cadeias

Function Verifique(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
    Verifique = L
End Function

Número de letras diferentes em uma cadeia

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

Foto: © VBA.

Nosso conteúdo é produzido em colaboração com especialistas em tecnologia da informação sob o comando de Jean-François Pillou, fundador do CCM.net. CCM é um site sobre tecnologia líder em nível internacional e está disponível em 11 idiomas.
Este documento, intitulado 'VBA: como misturar os caracteres de uma cadeia', está disponível sob a licença Creative Commons. Você pode copiar e/ou modificar o conteúdo desta página com base nas condições estipuladas pela licença. Não se esqueça de creditar o CCM (br.ccm.net) ao utilizar este artigo.

Assine nossa newsletter!
Assine nossa newsletter!