[Excel] Suddividere una stringa

[motino30]

Ciao Ricky, ciao Anthony e ciao Flash

Come state ? Grazie ai vostri suggerimenti informatici, ho riscontrato un successone sia con le colleghe e sia con i bimbi;
Siete stati davvero grandi !

Volevo chiedervi un altra cortesia, se vi sarà possibile.

Vorrei cominciare un altro lavoro per insegnare a distinguere vocali e consonanti dei propri nomi e cognomi dei bambini.
Vi faccio subito un chiaro esempio:
Digito in un campo il nome ed in un altro campo il cognome

Per poter far comprendere ogni singola lettera dell'alfabeto vorrei poter scomporre così nome e cognome:

Scrivo MARIA nel campo B2 e vorrei trasferire in C2 la M, in C3 la A, in C4 la R, in C5 la I, in C6 la A -
Poi scrivo il cognome ROSSI in E2 e vorrei trasferire in F2 la R, in F3 la O, in F4 la S, in F5 la S, in F6 la I -

Come fare questo con una macro ?

So che mi accompagnerete in questa ulteriore impresa e vi mando un caro abbraccio a tutti e tre

Un ciao caloroso Antonella

[ricky53]

Ciao.

Al volo perchè devo andare a prendere ...

Codice: Seleziona tutto

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address(0, 0) = "B2" Or Target.Address(0, 0) = "E2" Then
        Application.EnableEvents = False
        Dim I As Integer, Lung As Integer, UR As Long
        If Target.Address(0, 0) = "B2" Then
            UR = Range("C" & Rows.Count).End(xlUp).Row
            Range("C2:C" & UR).ClearContents
            Lung = Len(Target)
            For I = 1 To Lung
                Cells(I + 1, "C") = Mid(Target, I, 1)
            Next I
        Else
            UR = Range("F" & Rows.Count).End(xlUp).Row
            Range("F2:F" & UR).ClearContents
            Lung = Len(Target)
            For I = 1 To Lung
                Cells(I + 1, "F") = Mid(Target, I, 1)
            Next I
        End If
        Application.EnableEvents = True
    End If
End Sub

copia il codice nel foglio ove vuoi inserire e dividere in lettere i nomi ed i cognomi; procedura:
-Seleziona il foglio,
-tasto destro
-visualizza codice
-copia, nella finestra di destra, il codice che ti ho inviato

Come cambierai in "B2" il nome o in "E2" il cognome automaticamente avrai la suddivisione in lettere


Prova e ...

[Anthony47]

Bentornata...
Ricky ti ha gia' dato una macro credo idonea per la tua richiesta, ma perche' vuoi farlo con una macro?
Nell' ipotesi che nome o cognome non siano piu' lunghi di 20 caratteri:
-selezioni C2:C20
-scrivi la formula

Codice: Seleziona tutto

=STRINGA.ESTRAI($B$2;RIF.RIGA(INDIRETTO("1:20"));1)

-confermi con Contr-Maiusc-Enter, non il solo Enter

Ripeti per F2:F20 dove inserirai la formula

Codice: Seleziona tutto

=STRINGA.ESTRAI($E$2;RIF.RIGA(INDIRETTO("1:20"));1)

Ciao

[motino30]

Ciao Ricky lieta di averti riletto.

Eri di corsa vero ? Mi spiace !

Sai avendo la domenica a disposizione volevo cimentarmi in un nuovo progettino.

Ho fatto esattamente quanto mi hai scritto e tutto funziona a meraviglia, ma devi considerare che l'entusiasmo
a volte ti fa perdere in un bicchier d'acqua.

Ti spiego Ricky ho impostato male la sequenza nelle caselle perchè se devo creare dei quadrati di una certa dimensione, visto che
ho anche nomi tipo Francesca Maria, Elisabetta, Maria Grazia, ed altri nomi lunghi, mi uscirebbero dalla pagina.

Per avere lo stesso lavoro ma sviluppato in orizzontale cosa o come dovrei correggere la macro ?

Esempio: la stessa Maria Rossi la scriverei in F4 ed in F5 la M - in G5 la A- in H5 la R - in I5 la I - in J5 la A
e fare la scomposizione del cognome, inserendolo in F7, in F8 la R - in G8 la O- in H8 la S - in I8 la S - in J8 la I

e questo perchè in orizzontale avrei molto più spazio.

Ti ringrazio anticipatamente e ti auguro un buon fine settimana
Antonella

[motino30]

Ciao Anthony,

come stai ? Lieta di rileggere anche te !

Volevo dirti che la macro che mi ha inviato Ricky era perfetta non appena l'ho provata, purtroppo, nella fretta di comunicare la mia necessità ho impostato la richiesta per uno sviluppo in verticale piuttosto che in orizzontale.
La macro la trovo molto più pratica ma solo che non mi appare mai nella lista delle macro.

Per tornare a quanto mi necessita ti reimposto l'esempio di come dovrebbe avvenire lo sviluppo:

Scrivo Maria in F4 e lo sviluppo dovrebbe avvenire per le lettere in F5, G5, H5, I5, J5, ecc...
Scrivo Rossi in F9 e lo sviluppo dovrebbe avvenire per le lettere in F10, G10, H10, I10, J10, ecc...

utilizzando una macro come mi ha inviato Ricky .... mi puoi aiutare ?

Un caloroso abbraccio
Antonella

[Anthony47]

Le formule che ti ho dato puoi usarle in orizzontale aggiungendo Matr.Trasposta, cioe'

Codice: Seleziona tutto

=MATR.TRASPOSTA(LaVecchiaFormula)


La cella che verra' smembrata e' quella indicata nella vecchia formula, dovrebbe essere semplice modificarla secondo le tue preferenze.

Ciao

[ricky53]

Ciao,
leggi quanto ti ha scritto Anthony ... e provalo.

Ecco la versione che scrive in orizzontale.
Hai cambiato le celle su cui scrivere i nomi ed i cognomi e la nuova versione l'ho adattata a queste celle.

La macro non va eseguita basta cambiare i valori di una delle due celle (F4 o F9) e ...

Codice: Seleziona tutto

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address(0, 0) = "F4" Or Target.Address(0, 0) = "F9" Then
        Application.EnableEvents = False
        Dim I As Integer, Lung As Integer, UR As Long
        If Target.Address(0, 0) = "F4" Then
            UC = Cells(5, Columns.Count).End(xlToLeft).Column
            Range("F5", Cells(10, UC)).ClearContents
            Lung = Len(Target)
            For I = 1 To Lung
                Cells(5, I + 5) = Mid(Target, I, 1)
            Next I
        Else
            UC = Cells(10, Columns.Count).End(xlToLeft).Column
            Range("F10", Cells(10, UC)).ClearContents
            Lung = Len(Target)
            For I = 1 To Lung
                Cells(10, I + 5) = Mid(Target, I, 1)
            Next I
        End If
        Application.EnableEvents = True
    End If
End Sub


[scossa]

Ciao,

ma lo "smembramento" vuoi eseguirlo in un "colpo solo" o una lettera alla volta (ad un tuo click su un comandbutton)?
Vuoi eseguirlo per nome e cognome insieme o separatamente (prima uno - con la modalidà sopra - poi l'altro)?

[motino30]

Ciao Ricky,

ho adottato la procedura da te suggerita, ho incollato il codice ma non funziona. Vorrei inviarti il mio foglio sul quale dovrei improntare il tutto; come posso fare a mandartelo ?

Antonella

[motino30]

Ciao Scossa, grazie per avermi risposto.

Vorrei poter suddividere tutto in un solo clic con una macro; già ricky mi ha inviato una macro ma non funziona.

Ciao Antonella

[scossa]

Un modo alternativo, usando "testo in colonne":

Codice: Seleziona tutto

Sub Scomponi()
  Dim ws As Worksheet
  Dim rngFr As Range
  Dim rngTo As Range
  Dim arrNome() As Variant
  Dim nLen As Long
  Dim j As Integer

  Application.DisplayAlerts = False
 
 Set ws = ActiveSheet
  Set rngFr = ws.Range("F4")
  Set rngTo = ws.Range("F5")
  With rngTo
    Intersect(.CurrentRegion, .EntireRow).ClearContents
  End With
  nLen = Len(rngFr.Text) - 1
  ReDim arrNome(nLen)
  For j = 0 To nLen
    arrNome(j) = VBA.Array(j, 1)
  Next j
  rngFr.TextToColumns Destination:=rngTo, DataType:=xlFixedWidth, _
        FieldInfo:=arrNome, _
        TrailingMinusNumbers:=True
 
  Set rngFr = ws.Range("F9")
  Set rngTo = ws.Range("F10")
  With rngTo
    Intersect(.CurrentRegion, .EntireRow).ClearContents
  End With
  nLen = Len(rngFr.Text) - 1
  ReDim arrNome(nLen)
  For j = 0 To nLen
    arrNome(j) = VBA.Array(j, 1)
  Next j
  rngFr.TextToColumns Destination:=rngTo, DataType:=xlFixedWidth, _
        FieldInfo:=arrNome, _
        TrailingMinusNumbers:=True
  Application.DisplayAlerts = True
  Set ws = Nothing
  Set rngFr = Nothing
  Set rngTo = Nothing
  Erase arrNome
End Sub

Nota: Vedere aggiornamento al codice pubblicato da scossa qui: viewtopic.php?f=26&t=101297&p=585738#p585738
Anthony

[ricky53]

Ciao,
dopo aver letto quanto ti è stato scritto prima e provato ...

Se posso permettermi: dire non funziona equivale a dire "NULLA".
Avresti dovuto dire:
ho fatto i seguenti passi
incollare il codice (dove lo hai incollato)
ho scritto "Maria" nella cella ...
ho ottenuto .....

In questo modo ti avrei potuto aiutare.

Il codice che ti ho inviato produce quello che hai chiesto ... c'era solo una cancellazione di un'area più grande ma non veniva inficiato il risultato voluto.

Ecco il codice corretto

Codice: Seleziona tutto

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address(0, 0) = "F4" Or Target.Address(0, 0) = "F9" Then
        Application.EnableEvents = False
        Dim I As Integer, Lung As Integer, UR As Long
        If Target.Address(0, 0) = "F4" Then
            UC = Cells(5, Columns.Count).End(xlToLeft).Column
            Range("F5", Cells(5, UC)).ClearContents
            Lung = Len(Target)
            For I = 1 To Lung
                Cells(5, I + 5) = Mid(Target, I, 1)
            Next I
        Else
            UC = Cells(10, Columns.Count).End(xlToLeft).Column
            Range("F10", Cells(10, UC)).ClearContents
            Lung = Len(Target)
            For I = 1 To Lung
                Cells(10, I + 5) = Mid(Target, I, 1)
            Next I
        End If
        Application.EnableEvents = True
    End If
End Sub

Ricordati che va copiato nel FOGLIO dove scriverai i nomi ed i cognomi.
Tu non devi fare altro che scrivere qualcosa in "F4" o in "F9" ed il codice verrà eseguito automaticamente

[ricky53]

Ciao Antonella,
ti invio un FILE sul quale provare

[motino30]

Carissimi Ricky, Anthony e Scossa

Vi ringrazio di cuore per le vostre disponibilità; ho iniziato il lavoro del progettino dei Nomi e Cognomi e penso già
di portarlo in asilo per lunedì mattina.

Siete delle persone splendide.

Un caloroso abbraccio ed un felice fine settimana
Antonella

[ricky53]

Ciao,
bene,
aggiornaci dei passi fatti e ... ovviamente sia che puoi contare su tutti noi

[scossa]

Come mi ha cortesemente fatto notare ricky (grazie), se il nome (od il cognome) contiene uno spazio (p.e.: Marco Antonio)
CurrentRegion viene ingannata per cui la seconda parte del vecchio nome non viene cancellata.

Per risolvere sostituire

Codice: Seleziona tutto

  With rngTo
    Intersect(.CurrentRegion, .EntireRow).ClearContents
  End With


con

Codice: Seleziona tutto

rngTo.EntireRow.ClearContents

P.S.: dando per scontato che le righe F5 ed F10 contengano solo il risultato della macro.