Questo sito utilizza cookie, anche di terze parti, per migliorare la tua esperienza e offrire servizi in linea con le tue preferenze. Chiudendo questo banner, scorrendo questa pagina o cliccando qualunque suo elemento acconsenti all’uso dei cookie

Rimani informato sugli aggiornamenti di SOS-OFFICE. Inserisci il tuo indirizzo e-mail: Informativa sulla privacy

Benvenuto, Ospite
Nome utente: Password: Ricordami

ARGOMENTO: Anagrammi

Anagrammi 4 Anni 3 Mesi fa #20

  • Santo
  • Avatar di Santo
  • Offline
  • Fresh Boarder
  • Messaggi: 17
Ciao,
In a1 ho una parola per esempio di cinque lettere. Come estrarre da b1 a scendere tutti i possibili anagrammi? Essi sono naturalmente 120.
Cogito ergo sum

Win 7 + Excel 2013
L\'Amministratore ha disattivato l\'accesso in scrittura al pubblico.

Anagrammi 4 Anni 3 Mesi fa #21

Che dommanda difficile!
Per me ci vuole vba. ti interessa, proviamo a scrivere la routine che lo fa
L\'Amministratore ha disattivato l\'accesso in scrittura al pubblico.

Anagrammi 4 Anni 3 Mesi fa #22

  • Santo
  • Avatar di Santo
  • Offline
  • Fresh Boarder
  • Messaggi: 17
Certamente nobilissima Alessandra
Cogito ergo sum

Win 7 + Excel 2013
L\'Amministratore ha disattivato l\'accesso in scrittura al pubblico.

Anagrammi 4 Anni 3 Mesi fa #23

grazie del nobilissima, comicio ad attivare le celluline grige, ma si accettano idee...
L\'Amministratore ha disattivato l\'accesso in scrittura al pubblico.

Anagrammi 4 Anni 2 Mesi fa #33

ho elaborato qualcosa.

Dim CurrentRow
Dim dati(1 To 200) As String
Dim numElem As Integer


Private Sub CommandButton1_Click()
numElem = 0
scegliTesto

End Sub

Sub scegliTesto()
Dim testo As String

Dim i As Integer
testo = InputBox("Inserisci il testo che vuoi anagrammare:")
If Len(testo) < 2 Then Exit Sub
If Len(S) >= 8 Then
MsgBox "testo troppo lungo!"
Exit Sub
Else
ActiveSheet.Columns(1).Clear
CurrentRow = 1

Anagramma "", testo
End If

MsgBox ("the end")

Erase dati
End Sub

Sub Anagramma(x As String, y As String)
Dim i As Integer, j As Integer

j = Len(y)
If j < 2 Then


If esiste(x & y) Then
inserisci (x & y)


End If
Else
For i = 1 To j
Call Anagramma(x + Mid(y, i, 1), _
Left(y, i - 1) + Right(y, j - i))
Next
End If


End Sub



Public Function esiste(parola As String) As Boolean

If Application.CheckSpelling(parola) Then

esiste = True

Else
esiste = False
End If

End Function

Public Sub inserisci(valore)

Dim blnTrovato As Boolean
Dim i As Integer

blnTrovato = False


For i = 1 To numElem
If UCase(dati(i)) = UCase(valore) Then
blnTrovato = True
Exit For
End If

Next

If blnTrovato = False Then
If Not IsEmpty(valore) Then
numElem = numElem + 1
dati(numElem) = valore
ActiveSheet.Cells(numElem, 1) = valore
End If

End If

End Sub


Questo codice mostra solo le parole che sono presenti nel dizionario dello spell Check per evitare di avere parole inutili, ma se lo vuoi disabilitare, non chiamare la funzione esiste.

This message has an attachment file.
Please log in or register to see it.

Ultima modifica: 4 Anni 2 Mesi fa da Alessandra.
L\'Amministratore ha disattivato l\'accesso in scrittura al pubblico.
Tempo creazione pagina: 0.098 secondi
Powered by Forum Kunena
Joomla templates by a4joomla