Macro for detect palindromes and repeats in letters/numbers string

Le
Luciano Paulino da Silva
Dear all,
I am looking to detect palindromes (sentence or number or other
sequence of units that can be read the same way in either direction)
and repeats (sequences of letters or numbers which are repeating
atleast twice within a string) in some strings containing between
20-5000 letters. Has somebody any idea how could I perform that using
an Excel macro? I would like that the string to be evaluated could be
on cell "A1" and that the detected palindromes and repeats could be
listed bellow A2 and C2, respectively; and that the number of times
that they appear in the sentence could be listed bellow cells B2 and
D2, respectively, as the following small example:

QGAGGAAGGAGQ
Palindromes Number Repeats Number
QGAGGAAGGAGQ 1 GA 3
GAG 2 AG 3
GG 2 GAG 2
AA 1 AA 1
GG 2

Somebody could help me?
Thanks in advance,
Luciano
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Luciano Paulino da Silva
Le #19114671
On 14 abr, 12:16, Luciano Paulino da Silva
Dear all,
I am looking to detect palindromes (sentence or number or other
sequence of units that can be read the same way in either direction)
and repeats (sequences of letters or numbers which are repeating
atleast twice within a string) in some strings containing between
20-5000 letters. Has somebody any idea how could I perform that using
an Excel macro? I would like that the string to be evaluated could be
on cell "A1" and that the detected palindromes and repeats could be
listed bellow A2 and C2, respectively; and that the number of times
that they appear in the sentence could be listed bellow cells B2 and
D2, respectively, as the following small example:

QGAGGAAGGAGQ
Palindromes     Number          Repeats         Num ber
QGAGGAAGGAGQ    1               GA              3
GAG             2               AG              3
GG              2               GAG             2
AA              1               AA              1
                                GG              2

Somebody could help me?
Thanks in advance,
Luciano





QGAGGAAGGAGQ
Palindromes Number Repeats Number
QGAGGAAGGAGQ 1 GA 3
GGAAGG 1 GG 2
GAAG 1 AG 3
GAG 2 GAG 2
GG 2
AA 1
MichDenis
Le #19117541
J'ai oublié de mentionner que les mots retenus comme
palindrome sont ceux validés par le dictionnaire en
vigueur dans Excel.
Luciano Paulino da Silva
Le #19118721
Dear MichDenis,
Thank you very much!
However, for an unknown reason I can not execute your code in order to
test it.
Thanks in advance,
Luciano

On 14 abr, 22:28, "MichDenis"
Bonjour Luciano,

La procédure qui suit est une idée originale
de Laurent Longre que j'ai modifiée.

Attention, si la longueur de chaîne de caractères
retenues est longue, de même que la chaîne maximale
de caractères, le temps de traitement s'allonge sensiblement.

Il se peut que que le service de messagerie coupe des lignes
de code à des endroits inopportuns.

Tout ce qui suit dans un module standard.
'------------------------------------------------------------------------ ---
'Longueur de la chaîne de caractères retenues
'à partir desquels les mots sont formés.
Const LgCh As Integer = 9
'Longueur minimale de chaîne
Const LgCombinMin As Integer = 2
'Longueur maximale de la chaîne
Const LgCombinMax As Integer = 5

Dim Niv As Integer
Dim LgCb As Integer
Dim Cbt As String
Dim J As Long
Dim D As Object
Dim Nb As Long

'------------------------------------------------------------------------ ----
Sub palindromes()

Dim I As Integer
Dim Lettre As String
Dim X As Long, A As Long

Set D = CreateObject("Scripting.Dictionary")
Nb = 0

For A = LgCombinMax + LgCombinMin To LgCombinMax - 1 Step -1
    With Application.WorksheetFunction
        X = X + .Fact(LgCh) / .Fact(A)
    End With
Next

If MsgBox("Nombre de combinaisons possible : " & X & _
    "." & vbCrLf & vbCrLf & "Désirez-vous continuer ?", _
    vbInformation + vbYesNo, "Attention") = vbYes Then

    Application.ScreenUpdating = True

    Application.Cursor = xlWait

    'Choix des lettres en minuscule pour la formation des mots.
    Lettre = "aosbitepy"

    With Sheets("Feuil1")
        .Cells.Clear
    End With
    With Sheets("Feuil2")
        .Cells.Clear
    End With

    For LgCb = LgCombinMax To LgCombinMin Step -1
        Cbt = Space$(LgCb): J = 0: Niv = 0
        Application.StatusBar = "Combinaisons à " & LgCb & " éléments..."
        Application.ScreenUpdating = False
        Récurse Lettre
        Application.ScreenUpdating = True
    Next LgCb
        Application.StatusBar = False
    ' Nom feuille où les données seront copiées
    'mots du dictionnaire courant d'excel que
    'l'on peut inverser
    With Sheets("Feuil2")
        .Range("A1").Resize(Nb) = Application.Transpose(D.Items )
    End With
Else
    MsgBox "opération annulée"
End If
Application.Cursor = xlDefault
End Sub
'------------------------------------------------------------------------ --
Private Sub Récurse(ByVal Lettre As String)

Dim I As Integer
If Niv < LgCb Then Niv = Niv + 1

For I = 1 To LgCh + 1 - Niv
    Mid$(Cbt, Niv, 1) = Mid$(Lettre, I, 1)
    If Niv < LgCb Then
        Récurse Left$(Lettre, I) & Mid$(Lettre, I + 1)
        Niv = Niv - 1
    Else
        J = J + 1
        'Nom feuille où toutes les combinaisons seront affich ées.
        With Sheets("Feuil1")
            .Cells(J, LgCombinMax + 1 - Niv) = Cbt
        End With
        If Application.CheckSpelling(Cbt, False) = True Then
            If Application.CheckSpelling(StrReverse(Cbt), Fal se) = True Then
                If Not D.Exists(Cbt) Then
                    D.Add Cbt, Cbt
                    Nb = Nb + 1
                End If
            End If
        End If
    End If
Next I
End Sub
'------------------------------------------------------------------------ ------

"Luciano Paulino da Silva" Dear all,
I am looking to detect palindromes (sentence or number or other
sequence of units that can be read the same way in either direction)
and repeats (sequences of letters or numbers which are repeating
atleast twice within a string) in some strings containing between
20-5000 letters. Has somebody any idea how could I perform that using
an Excel macro? I would like that the string to be evaluated could be
on cell "A1" and that the detected palindromes and repeats could be
listed bellow A2 and C2, respectively; and that the number of times
that they appear in the sentence could be listed bellow cells B2 and
D2, respectively, as the following small example:

QGAGGAAGGAGQ
Palindromes Number Repeats Number
QGAGGAAGGAGQ 1 GA 3
GAG 2 AG 3
GG 2 GAG 2
AA 1 AA 1
GG 2

Somebody could help me?
Thanks in advance,
Luciano


Luciano Paulino da Silva
Le #19121591
Dear Dear MichDenis,
Thank you very much for the file. However, I tried use it but received
the sentence "Nombre de combinasions possibles: 18720" and I had only
an "A"
on cell A1.
Do you know what happened?
Thanks,
Luciano


On 15 abr, 08:41, "MichDenis"
http://cjoint.com/?erdux8bQrL

"Luciano Paulino da Silva" Dear MichDenis,
Thank you very much!
However, for an unknown reason I can not execute your code in order to
test it.
Thanks in advance,
Luciano

On 14 abr, 22:28, "MichDenis"
> Bonjour Luciano,

> La procédure qui suit est une idée originale
> de Laurent Longre que j'ai modifiée.

> Attention, si la longueur de chaîne de caractères
> retenues est longue, de même que la chaîne maximale
> de caractères, le temps de traitement s'allonge sensiblement.

> Il se peut que que le service de messagerie coupe des lignes
> de code à des endroits inopportuns.

> Tout ce qui suit dans un module standard.
> '---------------------------------------------------------------------- -----
> 'Longueur de la chaîne de caractères retenues
> 'à partir desquels les mots sont formés.
> Const LgCh As Integer = 9
> 'Longueur minimale de chaîne
> Const LgCombinMin As Integer = 2
> 'Longueur maximale de la chaîne
> Const LgCombinMax As Integer = 5

> Dim Niv As Integer
> Dim LgCb As Integer
> Dim Cbt As String
> Dim J As Long
> Dim D As Object
> Dim Nb As Long

> '---------------------------------------------------------------------- ------
> Sub palindromes()

> Dim I As Integer
> Dim Lettre As String
> Dim X As Long, A As Long

> Set D = CreateObject("Scripting.Dictionary")
> Nb = 0

> For A = LgCombinMax + LgCombinMin To LgCombinMax - 1 Step -1
>     With Application.WorksheetFunction
>         X = X + .Fact(LgCh) / .Fact(A)
>     End With
> Next

> If MsgBox("Nombre de combinaisons possible : " & X & _
>     "." & vbCrLf & vbCrLf & "Désirez-vous continuer ?", _
>     vbInformation + vbYesNo, "Attention") = vbYes Then

>     Application.ScreenUpdating = True

>     Application.Cursor = xlWait

>     'Choix des lettres en minuscule pour la formation des mots.
>     Lettre = "aosbitepy"

>     With Sheets("Feuil1")
>         .Cells.Clear
>     End With
>     With Sheets("Feuil2")
>         .Cells.Clear
>     End With

>     For LgCb = LgCombinMax To LgCombinMin Step -1
>         Cbt = Space$(LgCb): J = 0: Niv = 0
>         Application.StatusBar = "Combinaisons à " & LgCb & " éléments..."
>         Application.ScreenUpdating = False
>         Récurse Lettre
>         Application.ScreenUpdating = True
>     Next LgCb
>         Application.StatusBar = False
>     ' Nom feuille où les données seront copiées
>     'mots du dictionnaire courant d'excel que
>     'l'on peut inverser
>     With Sheets("Feuil2")
>         .Range("A1").Resize(Nb) = Application.Transpose(D.Ite ms)
>     End With
> Else
>     MsgBox "opération annulée"
> End If
> Application.Cursor = xlDefault
> End Sub
> '---------------------------------------------------------------------- ----
> Private Sub Récurse(ByVal Lettre As String)

> Dim I As Integer
> If Niv < LgCb Then Niv = Niv + 1

> For I = 1 To LgCh + 1 - Niv
>     Mid$(Cbt, Niv, 1) = Mid$(Lettre, I, 1)
>     If Niv < LgCb Then
>         Récurse Left$(Lettre, I) & Mid$(Lettre, I + 1)
>         Niv = Niv - 1
>     Else
>         J = J + 1
>         'Nom feuille où toutes les combinaisons seront affich ées.
>         With Sheets("Feuil1")
>             .Cells(J, LgCombinMax + 1 - Niv) = Cbt
>         End With
>         If Application.CheckSpelling(Cbt, False) = True Then
>             If Application.CheckSpelling(StrReverse(Cbt), F alse) = True Then
>                 If Not D.Exists(Cbt) Then
>                     D.Add Cbt, Cbt
>                     Nb = Nb + 1
>                 End If
>             End If
>         End If
>     End If
> Next I
> End Sub
> '---------------------------------------------------------------------- --------

> "Luciano Paulino da Silva" > Dear all,
> I am looking to detect palindromes (sentence or number or other
> sequence of units that can be read the same way in either direction)
> and repeats (sequences of letters or numbers which are repeating
> atleast twice within a string) in some strings containing between
> 20-5000 letters. Has somebody any idea how could I perform that using
> an Excel macro? I would like that the string to be evaluated could be
> on cell "A1" and that the detected palindromes and repeats could be
> listed bellow A2 and C2, respectively; and that the number of times
> that they appear in the sentence could be listed bellow cells B2 and
> D2, respectively, as the following small example:

> QGAGGAAGGAGQ
> Palindromes Number Repeats Number
> QGAGGAAGGAGQ 1 GA 3
> GAG 2 AG 3
> GG 2 GAG 2
> AA 1 AA 1
> GG 2

> Somebody could help me?
> Thanks in advance,
> Luciano


MichDenis
Le #19121961
La procédure contenue dans ce classeur a été testée sur les versions d'Excel 2003 et 2007 de langue française. Tout fonctionne correctement. Tu ne donnes pas beaucoup d'informations concernant l'environnement dans lequel tu évolues. En principe, cette procédure devrait fonctionner pour toutes les versions d'Excel (1997 à 2007).

Il ne reste plus qu'à compter sur la communauté, si quelqu'un ayant une autre version d'Excel ou d'une autre langue veut bien tester le fichier et nous faire parvenir leurs commentaires quant aux résultats qu'ils obtiennent.
Publicité
Poster une réponse
Anonyme