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
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
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
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" a écrit dans le message de groupe de discussion : d77c6d5a-a312-43de-91c0-a8a2e37f7...@ g19g2000yql.googlegroups.com...
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
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" <lucianopaulinosi...@gmail.com> a écrit dans le message de groupe de discussion : d77c6d5a-a312-43de-91c0-a8a2e37f7...@ g19g2000yql.googlegroups.com...
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
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" a écrit dans le message de groupe de discussion : d77c6d5a-a312-43de-91c0-a8a2e37f7...@ g19g2000yql.googlegroups.com...
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
http://cjoint.com/?erdux8bQrL
"Luciano Paulino da Silva" a écrit dans le message de groupe de discussion : 85acd58a-2ad3-429e-af27-90c3991dd...@ g19g2000yql.googlegroups.com...
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" wrote:
> 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" a écrit da ns le message de groupe de discussion : d77c6d5a-a312-43de-91c0-a8a2e37f7..
> 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
http://cjoint.com/?erdux8bQrL
"Luciano Paulino da Silva" <lucianopaulinosi...@gmail.com> a écrit dans le message de groupe de discussion : 85acd58a-2ad3-429e-af27-90c3991dd...@ g19g2000yql.googlegroups.com...
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" <michde...@hotmail.com> wrote:
> 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" <lucianopaulinosi...@gmail.com> a écrit da ns le message de groupe de discussion : d77c6d5a-a312-43de-91c0-a8a2e37f7.. .@g19g2000yql.googlegroups.com...
> 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
http://cjoint.com/?erdux8bQrL
"Luciano Paulino da Silva" a écrit dans le message de groupe de discussion : 85acd58a-2ad3-429e-af27-90c3991dd...@ g19g2000yql.googlegroups.com...
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" wrote:
> 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" a écrit da ns le message de groupe de discussion : d77c6d5a-a312-43de-91c0-a8a2e37f7..
> 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