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

Anagrammi

Vai
6 Anni 9 Mesi fa #20 da Santo
COM_KUNENA_MESSAGE_CREATED_NEW
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

Si prega Accedi o Crea un account a partecipare alla conversazione.

Vai
6 Anni 9 Mesi fa #21 da Alessandra
COM_KUNENA_MESSAGE_REPLIED_NEW
Che dommanda difficile!
Per me ci vuole vba. ti interessa, proviamo a scrivere la routine che lo fa

Si prega Accedi o Crea un account a partecipare alla conversazione.

Vai
6 Anni 9 Mesi fa #22 da Santo
COM_KUNENA_MESSAGE_REPLIED_NEW
Certamente nobilissima Alessandra

Cogito ergo sum

Win 7 + Excel 2013

Si prega Accedi o Crea un account a partecipare alla conversazione.

Vai
6 Anni 9 Mesi fa #23 da Alessandra
COM_KUNENA_MESSAGE_REPLIED_NEW
grazie del nobilissima, comicio ad attivare le celluline grige, ma si accettano idee...

Si prega Accedi o Crea un account a partecipare alla conversazione.

Vai
6 Anni 8 Mesi fa - 6 Anni 8 Mesi fa #33 da Alessandra
COM_KUNENA_MESSAGE_REPLIED_NEW
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.

Questo messaggio ha un file allegato.
Accedi o registrati per visualizzarlo.

Last edit: 6 Anni 8 Mesi fa by Alessandra.

Si prega Accedi o Crea un account a partecipare alla conversazione.

Tempo creazione pagina: 0.700 secondi
Powered by Forum Kunena
Joomla templates by a4joomla