Anagramme

Bonjour

Un internaute, dont j'ai oublié le nom, il m'en excusera, avait pondu cette courte macro qui fonctionnait très bien sur Excel 2003 :

elle permettait de trouver tous les anagrammes d'un mot, la limitation (notamment avec Excel 2003) étant le nombre de lignes d'affichage possible (elle plantait dès que le mot avait plus de 7 ou 8 lettres) :

Sub AppelCombi()

Dim TexteCombi As String, Tablo

TexteCombi = Application.InputBox(prompt:="Entrer le texte ici")

Range("A:A").ClearContents

Set Dico = CreateObject("Scripting.Dictionary")

Call Combi("", TexteCombi)

Tablo = Dico.keys

For j = 1 To Dico.Count

Range("A" & j).Value = Tablo(j - 1)

Next j

Application.Run Range("motsCroisés.xls!nbValA")

End Sub

Sub Combi(Prefixe As String, Texte As String)

Dim i As Long

If Len(Texte) <= 1 Then

Dico(Prefixe & Texte) = Prefixe & Texte

Else

For i = 1 To Len(Texte)

Call Combi(Prefixe & Mid(Texte, i, 1), Left(Texte, i - 1) & Right(Texte, Len(Texte) - i))

Next i

End If

End Sub

J'ai tenté de la transposer à Excel 2007 mais ça coince : le message est :

Erreur de compilation :

Sub ou Function non définie

avec en surligné

Dico(Prefixe & Texte) =

Étant nul en macros VBA (j'en suis resté aux macros 4.0...), je ne suis pas capable de réparer l'erreur affichée au débogage.

Une âme charitable et compétente peut-elle m'apporter les corrections nécessaires ? Elle en sera remerciée.

Bonjour

A tester

Option Explicit

Dim Dico As Object

Sub AppelCombi()
Dim TexteCombi As String, Tablo
Dim J As Long

  TexteCombi = Application.InputBox(prompt:="Entrer le texte ici")
  Range("A:A").ClearContents
  Set Dico = CreateObject("Scripting.Dictionary")
  Call Combi("", TexteCombi)
  Tablo = Dico.keys
  For J = 1 To Dico.Count
    Range("A" & J).Value = Tablo(J - 1)
  Next J
  'Application.Run Range("motsCroisés.xls!nbValA")
End Sub

Sub Combi(Prefixe As String, Texte As String)
Dim i As Long
  If Len(Texte) <= 1 Then
    Dico(Prefixe & Texte) = Prefixe & Texte
  Else
    For i = 1 To Len(Texte)
      Call Combi(Prefixe & Mid(Texte, i, 1), Left(Texte, i - 1) & Right(Texte, Len(Texte) - i))
    Next i
  End If
End Sub

Merci Benzai64 de vos corrections.

ça semble fonctionner parfaitement, avec cette limitation qui tient à Excel (2007) :

le nombre de cellules dans une colonne est de 1048576.

Pour 9 lettres, le nombre de permutations possibles est de 362880 (9!), ça rentre dans la colonne.

Pour 10 lettres, le nombre de permutations possibles est de 3628800 (10!), ça ne rentre plus dans la colonne et la macro tourne indéfiniment sans résultat.

Que rajouter au texte de cette macro pour qu'elle stoppe immédiatement dès le début et prévienne que le mot choisi dépasse 9 lettres ?

Que rajouter au texte de cette macro pour qu'elle affiche en B2 par exemple le nombre de permutations possibles dans ce mot de n lettres ?

C'est sans doute trivial pour un pratiquant du langage macro VBA mais pas pour moi.

Merci encore.

Bonjour

A tester

Option Explicit

Dim Dico As Object

Sub AppelCombi()
Dim TexteCombi As String, Tablo
Dim J As Long

  TexteCombi = Application.InputBox(prompt:="Entrer le texte ici")
  If Len(TexteCombi) > 9 Then
    MsgBox "Trop de possibilité : " & Application.Permut(Len(TexteCombi), Len(TexteCombi))
    Exit Sub
  End If
  Range("B2") = Application.Permut(Len(TexteCombi), Len(TexteCombi))
  Range("A:A").ClearContents
  Set Dico = CreateObject("Scripting.Dictionary")
  Call Combi("", TexteCombi)
  Tablo = Dico.keys
  For J = 1 To Dico.Count
    Range("A" & J).Value = Tablo(J - 1)
  Next J
  'Application.Run Range("motsCroisés.xls!nbValA")
End Sub

Sub Combi(Prefixe As String, Texte As String)
Dim i As Long
  If Len(Texte) <= 1 Then
    Dico(Prefixe & Texte) = Prefixe & Texte
  Else
    For i = 1 To Len(Texte)
      Call Combi(Prefixe & Mid(Texte, i, 1), Left(Texte, i - 1) & Right(Texte, Len(Texte) - i))
    Next i
  End If
End Sub

Bonjour banzai64.

Merci encore pour votre intervention.

Le fichier se trouve ici :

https://www.cjoint.com/c/ELmx621R2iC

et la macro fonctionne tout à fait bien.

Au revoir.

Bonsoir @ tous,

une autre en fichier joint.

Cordialement

Bonjour

Merci pour ce fichier Cjoint mais impossible de le lire (affichage d’icônes successives et de points d'interrogations).

Une idée ?

Vérification faite, mon propre envoi de mon fichier par CJoint n'est pas non plus lisible (par moi, en tout cas) une fois téléchargé.

Donc, et à tout hasard, au cas où il intéresserait quelqu'un, je le joins dans ce message-ci :

83anagramme.xlsm (21.63 Ko)

Bonjour,

c'est un ami sur un notre forum qui a fait la macro.

@ + +

Bonjour

Merci à cet ami (son nom ou pseudo ?) et aux autres qui ont mis "leur patte" dans son élaboration.

Le fichier CJoint ne semblant pas disponible, R@chid pourrait-il mettre ce fichier en pièce jointe comme je l'ai fait pour le mien ?

Merci encore.

Rechercher des sujets similaires à "anagramme"