[Risolto] Macro per divisione cella di testo in più celle

[mkback]

Ciao a tutti,
ho la necessità di suddividere delle celle di testo da 80/90 caratteri in piu celle di max 30 caratteri l'una. La divisione dovrebbe rispettare gli spazi delle parole e non troncarmi il testo precisamente alla trentesima lettera.. mi spiego meglio con un esempio:
la cella A1 contiene il seguente testo:
oggi chiederò aiuto al forum per una formula o macro
E' una cella da 52 caratteri e quindi la devo dividere in due parti di max 30 caratteri l'una
Il trentesimo carattere della prima cella sarebbe "p" (di "per"); se tronco prorpio alla "p", mi ritroverei la seconda cella che inizia con "er una....";
Io quindi vorrei terminasse a "forum " cosicchè la seconda cella inizierebbe con "per una for......"; (mi sta bene se i caratteri sono meno di trenta)

Al massimo dovrei avere sempre meno di 120 caratteri circa su una cella da dividere, quindi la divisione dovrebbe avvenire sempre in 4 celle massimo alla fine dell'operazione.

Un tempo un ex collega mi aveva fatto una macro in VB, ma non mi funziona più (forse dipende dalla versione di excell); se qualcuno la volesse studiare per prendere spunto, la posso postare.
Premetto che con le formule di excell me la cavicchio, mentre di VB non so un accidente!
Grazie
p.s.: ho il microsoft office 2010 plus

[cromagno]

E' una cella da 52 caratteri e quindi la devo dividere in due parti di max 30 caratteri l'una
Il trentesimo carattere della prima cella sarebbe "p" (di "per"); se tronco prorpio alla "p", mi ritroverei la seconda cella che inizia con "er una....";
Io quindi vorrei terminasse a "forum " cosicchè la seconda cella inizierebbe con "per una for......"; (mi sta bene se i caratteri sono meno di trenta)

Ciao,
stai prendendo come esempio un file che noi non vediamo.
Allega il file e scrivi manualmente il risultato che vorresti ottenere, per evitare di fare un lavoro che non si adatti al file originale.

[mkback]

Ciao,
stai prendendo come esempio un file che noi non vediamo.
Allega il file e scrivi manualmente il risultato che vorresti ottenere, per evitare di fare un lavoro che non si adatti al file originale.

Scusate, credevo di essermi spiegato bene...

sulla cella A1 c'è il testo da dividere (sulla cella A2 ho indicato la lunghezza); sulle successive (B1,B2,B3,B4) vi è il risultato di ciò che mi serve, ossia la divisione del testo in celle da max 30 caratteri, senza dividere in sillabe [anche qui ho indicato sotto la lunghezza, per essere più chiaro]

il file della macro vecchia non riesco a caricarlo, perchè non accetta l'estensione...
lo indico di seguito:

"Attribute VB_Name = ""Programma"""
Option Explicit
Option Base 1

Sub DividiRiga()
"Attribute DividiRiga.VB_ProcData.VB_Invoke_Func = ""w\n14"""
Dim Testo, Riga1, Riga2, Riga3, Riga4 As String
Dim Pos As Variant

Testo = ActiveCell.Value

'####### Riga 1
If Len(Testo) > 30 Then
" Pos = InStrRev(Testo, "" "", 30, 0)"
Riga1 = Left(Testo, Pos - 1)
Testo = Mid(Testo, Pos + 1)
Else
Riga1 = Testo s
" Testo = """"" s
End If s
s
'####### Riga 2
If Len(Testo) > 30 Then
" Pos = InStrRev(Testo, "" "", 30, 0)"
Riga2 = Left(Testo, Pos - 1)
Testo = Mid(Testo, Pos + 1)
Else
Riga2 = Testo
" Testo = """""
End If

'####### Riga 3
If Len(Testo) > 30 Then
" Pos = InStrRev(Testo, "" "", 30, 0)"
Riga3 = Left(Testo, Pos - 1)
Testo = Mid(Testo, Pos + 1)
Else
Riga3 = Testo
" Testo = """""
End If

'####### Riga 4
If Len(Testo) > 30 Then
" Pos = InStrRev(Testo, "" "", 30, 0)"
Riga4 = Left(Testo, Pos - 1)
Testo = Mid(Testo, Pos + 1)
Else
Riga4 = Testo
" Testo = """""
End If

ActiveCell.Offset(0, 1).Value = Riga1
ActiveCell.Offset(0, 2).Value = Riga2
ActiveCell.Offset(0, 3).Value = Riga3
ActiveCell.Offset(0, 4).Value = Riga4
ActiveCell.Offset(1, 0).Activate

End Sub

@ mkback

Il codice va racchiuso tra i tag code; questa volta l'ho fatto io e ricordatene per il futuro.

[mkback]

ecco... ora sono riuscito a caricarvi il file della macro.....

[mkback]

grazie! scusa ma non riuscivo a farlo!

nessuno mi può aiutare con questa macro?

[rollis13]

Credo sia solo necessario ripulire il codice in quanto risulta "inquinato". Ho approfittato per aggiungere alcuni "Trim" per togliere eventuali caratteri spazio in esubero.
es. Riga1 = Trim(Left(Testo, Pos - 1))
es. Riga1 = Trim(Testo)

Option Explicit
Option Base 1
    
Sub DividiRiga()

    Dim Testo As String, Riga1 As String, Riga2 As String, Riga3 As String, Riga4 As String
    Dim Pos As Variant
        
    Testo = ActiveCell.Value
        
    '####### Riga 1
    If Len(Testo) > 30 Then
        Pos = InStrRev(Testo, " ", 30, 0)
        Riga1 = Trim(Left(Testo, Pos - 1))
        Testo = Mid(Testo, Pos + 1)
    Else
        Riga1 = Trim(Testo)
        Testo = ""
    End If
        
    '####### Riga 2
    If Len(Testo) > 30 Then
        Pos = InStrRev(Testo, " ", 30, 0)
        Riga2 = Trim(Left(Testo, Pos - 1))
        Testo = Mid(Testo, Pos + 1)
    Else
        Riga2 = Trim(Testo)
        Testo = ""
    End If
        
    '####### Riga 3
    If Len(Testo) > 30 Then
        Pos = InStrRev(Testo, " ", 30, 0)
        Riga3 = Trim(Left(Testo, Pos - 1))
        Testo = Mid(Testo, Pos + 1)
    Else
        Riga3 = Trim(Testo)
        Testo = ""
    End If
        
    '####### Riga 4
    If Len(Testo) > 30 Then
        Pos = InStrRev(Testo, " ", 30, 0)
        Riga4 = Trim(Left(Testo, Pos - 1))
        Testo = Mid(Testo, Pos + 1)
    Else
        Riga4 = Trim(Testo)
        Testo = ""
    End If
        
    ActiveCell.Offset(0, 1).Value = Riga1
    ActiveCell.Offset(0, 2).Value = Riga2
    ActiveCell.Offset(0, 3).Value = Riga3
    ActiveCell.Offset(0, 4).Value = Riga4
    ActiveCell.Offset(1, 0).Activate
    
End Sub

[cromagno]

Devo terminare il codice che ho iniziato stamattina (prima del tuo secondo file allegato che non ho visto)...
quando rientro a casa lo completo, anche se sto vedendo ora che probabilmente @rollis ti ha tolto le castagne dal fuoco

[rollis13]

Scusami cromagno , dato che si trattava solo d'un problema d' "ortografia" e l'utente "premeva" .
E già che c'ero ho approfittato per rifilarlo un po' (in modo da confrontarlo col tuo appena terminato ).

Option Explicit
    
Sub DividiRiga_2()

    Dim Testo As String
    Dim Pos As Integer
    Dim x As Integer
    Dim riga As Variant

    Testo = ActiveCell.Value
    ReDim riga(1 To 4) As String
    
    For x = 1 To 4
        If Len(Testo) > 30 Then
            Pos = InStrRev(Testo, " ", 30, 0)
            riga(x) = Trim(Left(Testo, Pos - 1))
            Testo = Mid(Testo, Pos + 1)
        Else
            riga(x) = Trim(Testo)
            Testo = ""
        End If
        ActiveCell.Offset(0, x).Value = riga(x)
    Next x
    ActiveCell.Offset(1, 0).Activate
    
End Sub

[cromagno]

Nessun problema rollis,
hai fatto benissimo ad intervenire ;)

[cromagno]

Questa la mia "versione":

Sub DIVIDI_TESTO()
Dim Testo As String, Parole() As String, Parte As String, Limite As Integer, i As Integer
Dim Cella As Integer, Nuovo_testo As String


Limite = InputBox("Inserire numero massimo di caratteri", "NUMERO CARATTERI")
Cella = 1
Testo = CStr(ActiveCell.Value)
Parole = Split(Testo, " ")
Parte = ""
For i = 0 To UBound(Parole)
    Parte = Parte & " " & Parole(i)
    If Len(Parte) <= Limite Then
        Nuovo_testo = Trim(Parte)
    Else
        ActiveCell.Offset(0, Cella).Value = Nuovo_testo
        Cella = Cella + 1
        Parte = ""
        i = i - 1
    End If
Next i
If Parte <> "" Then
    ActiveCell.Offset(0, Cella).Value = Nuovo_testo
End If
End Sub

Come per quella modificata da @rollis13, ci si posiziona sopra la cella col "testo intero" e si avvia la macro.

Allego il file con entrambe le macro...

P.S.
il limite, 30 caratteri nel tuo esempio, lo devi inserire in una inputbox che appare quando avvii il codice.
Inizialmente avevo usato questa inputbox per fare delle prove anche con un limite diverso da 30 caratteri...ma alla fine l'ho lasciata

[rollis13]

Ottimo cromagno, hai fatto bene a renderla flessibile altrimenti rimaneva "monca" e solo per i fini prefissati. Nei limiti dei 30 minuti ho dato una ritoccatina al codice del post #8 .

[cromagno]

Nei limiti dei 30 minuti ho dato una ritoccatina al codice del post #8 .

Cioè, erano già passati i 30 minuti?

[rollis13]

No, ero arrivato giusto nei 29:5x tanto che poi non sono più riuscito nemmeno ad inserire un PS o un Edit.
Poca cosa comunque, a volte scrivo codice di slancio e poi mi pento delle brutture che ho scritto .

[mkback]

Non so come ringraziarvi! Funziona alla grande!
Unico appunto: su un file già esistente, come faccio a far partire la macro?

[rollis13]

Una volta posizionato il cursore sulla cella interessata con i tasti Alt+F8 apri la finestra delle macro, la selezioni e la Esegui.
Si utile, magari perché l'operazione va ripetuta molte volte, ti puoi creare un pulsante ed associare la macro ad esso. Oppure, puoi modificare la macro affinché elabori un range più ampio di celle.

[mkback]

Ma se faccio alt+f8 su un file vecchio, la macro non è ancora caricata.... il mio problema è trovarmela sull'elenco delle macro...(scusate, ma questa parte di excell, non mi va prorpio giù! anche se mi piacerebbe molto impararla!))
Rollis, se volessi modificare il numero di caratteri dentro VB, dove devo andare? Va bene anche quello di Cromagnon, però nel caso in cui devo dividere una montagna di celle, perderei troppo tempo a dover scrivere la lunghezza ad ogni cambio cella, quindi il tuo è più veloce. L'unica cosa è impostare la lunghezza... (la posso fare anche da vb, senza che perdiate altro tempo!)
grazie!

[mkback]

Rollis, se volessi modificare il numero di caratteri dentro VB, dove devo andare? Va bene anche quello di Cromagnon, però nel caso in cui devo dividere una montagna di celle, perderei troppo tempo a dover scrivere la lunghezza ad ogni cambio cella, quindi il tuo è più veloce. L'unica cosa è impostare la lunghezza... (la posso fare anche da vb, senza che perdiate altro tempo!)
grazie!

ho trovato! sono riuscito a capire dentro vb dove modificare la lunghezza... solo che se imposto ad esempio "10" lui mi divide la prima parte di stringa mentre il restante va perso...

[mkback]

Fatto tutto! smanettando sono riuscito anche a non perdere il restante! comincio ad appassionarmi!

Sub DividiRiga_2()

    Dim Testo As String, Riga1 As String, Riga2 As String, Riga3 As String, Riga4 As String, Riga5 As String, Riga6 As String
    Dim Pos As Integer
    Dim x As Integer
    Dim riga As Variant

    Testo = ActiveCell.Value
    riga = Array(Riga1, Riga2, Riga3, Riga4, Riga5, Riga6)
    For x = 0 To 5
        If Len(Testo) > 20 Then
            Pos = InStrRev(Testo, " ", 20, 0)
            riga(x) = Trim(Left(Testo, Pos - 1))
            Testo = Mid(Testo, Pos + 1)
        Else
            riga(x) = Trim(Testo)
            Testo = ""
        End If
        ActiveCell.Offset(0, x + 1).Value = riga(x)
    Next x
    ActiveCell.Offset(1, 0).Activate
    
End Sub

qui ho fatto una divisione in celle da max 20 caratteri, max 6 celle (l'unica cosa che non so se dovevo modificare è il "For x = 0 To 3" ... l'ho messo a "for x= 0 to 5" pensando sia il numero di celle che va a gestire...

[rollis13]

La logica delle modifiche che hai apportato è corretta. Ti suggerisco, però, di utilizzare l'ultima versione della mia macro quella nel post #8.

Invece, se non vuoi dover prestare molta attenzione per le modifiche, utilizza la macro di cromagno che è più "aperta"; devi solamente cambiare una riga in modo da rendere il numero fisso anziché interattivo.
Ricorda di non abbassare troppo il valore, devi "coprire" almeno la lunghezza della parola più lunga più uno spazio.

da:
Limite = InputBox("Inserire numero massimo di caratteri", "NUMERO CARATTERI")
a:
Limite = 20     'indicare il numero di caratteri

[mkback]

La logica delle modifiche che hai apportato è corretta. Ti suggerisco, però, di utilizzare l'ultima versione della mia macro quella nel post #8.

Invece, se non vuoi dover prestare molta attenzione per le modifiche, utilizza la macro di cromagno che è più "aperta"; devi solamente cambiare una riga in modo da rendere il numero fisso anziché interattivo.

da:
Limite = InputBox("Inserire numero massimo di caratteri", "NUMERO CARATTERI")
a:
Limite = 20     'indicare il numero di caratteri

Grazie!

[rollis13]

@mkback, una domanda OffTopic, nell'ultima risposta hai riportato per intero il mio precedente post, è perché hai cliccato "Rispondi Citando" al posto di "Rispondi" o è solo perché non ti sei Registrato/Autenticato al Forum prima di rispondere ?

[mkback]

@mkback, una domanda OffTopic, nell'ultima risposta hai riportato per intero il mio precedente post, è perché hai cliccato "Rispondi Citando" al posto di "Rispondi" o è solo perché non ti sei Registrato/Autenticato al Forum prima di rispondere ?

ho schiacciato rispondi citando come ora....

[rollis13]

Ah, ecco, era solo perché già sapevo cosa avevo scritto e non serviva ripetermelo , mica sono sordo .

[scossa]

Ciao,

tanto per cambiare arrivo tardi.

Propongo questa udf da utilizzare anche lato celle.
Ho limitato a 5 le celle di suddivisione ma nulla vieta di usarne a piacere:

Function uChunckString(ByVal sString As String) As Variant
  Dim nLen As Variant
  Dim j As Long
  Dim aChunck(1 To 1, 1 To 5) As Variant
  
  nLen = 0
  For j = 1 To 5
    nLen = InStrRev(Left(sString, 31), " ")
    aChunck(1, j) = Trim(Left(sString, nLen - 1))
    sString = Trim(Replace(sString, aChunck(1, j), "")) & " "
    nLen = 0
  Next
  uChunckString = aChunck
  Erase aChunck
End Function

E' una udf matriciale: testo in A1, selezionare le 4 o 5 celle dove si vuole il risultato ed inserire::
=uChunckString(A1)
da confermare con ctrl+maiusc+invio

Volendo si possono estrarre le singole stringhe da max 30 caratteri:
primi max 30:: =INDICE(uChunckString($A6);1;1)
secondi max 30:: =INDICE(uChunckString($A6);1;2)
terzi max 30:: =INDICE(uChunckString($A6);1;3)
etcc...

normali da confermare col solo invio.

[scossa]

Volendo evitare il VBA:

in B1:: =ANNULLA.SPAZI(SINISTRA($A1;MAX(SE.ERRORE(TROVA(" ";$A1;RIF.RIGA(A$1:A$120))*(TROVA(" ";$A1;RIF.RIGA(A$1:A$120))<32);0))))

in C1:: =ANNULLA.SPAZI(SINISTRA(SOSTITUISCI($A1;B1;"");MAX(SE.ERRORE(TROVA(" ";SOSTITUISCI($A1;B1;"");RIF.RIGA(B$1:B$120))*(TROVA(" ";SOSTITUISCI($A1;B1;"");RIF.RIGA(B$1:B$120))<32);0))))

in D1:: =ANNULLA.SPAZI(SINISTRA(SOSTITUISCI($A1;B1& " "&C1&" ";"");MAX(SE.ERRORE(TROVA(" ";SOSTITUISCI($A1;B1&" "&C1&" ";"");RIF.RIGA(A$1:A$120))*(TROVA(" ";SOSTITUISCI($A1;B1&" "&C1&" ";"");RIF.RIGA(A$1:A$120))<32);0))))

in E1:: =ANNULLA.SPAZI(SINISTRA(SOSTITUISCI($A1;B1&" "&C1&" "&D1;"");MAX(SE.ERRORE(TROVA(" ";SOSTITUISCI($A1&" ";B1&" "&C1&" "&D1;"");RIF.RIGA(A$1:A$119))*(TROVA(" ";SOSTITUISCI($A1&" ";B1&" "&C1&" "&D1;"");RIF.RIGA(A$1:A$119))<32);0))))

[mkback]

grazie!

[mkback]

scusa rollis13!