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
"Sono le persone che nessuno immagina che possano fare certe cose, quelle che fanno cose che nessuno può immaginare."
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:
@ mkbackCodice:"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
Il codice va racchiuso tra i tag code; questa volta l'ho fatto io e ricordatene per il futuro.
Ultima modifica fatta da:alfrimpa; 19/09/16 alle 16:08
ecco... ora sono riuscito a caricarvi il file della macro.....
grazie! scusa ma non riuscivo a farlo!
nessuno mi può aiutare con questa macro?
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)
Codice: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
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![]()
"Sono le persone che nessuno immagina che possano fare certe cose, quelle che fanno cose che nessuno può immaginare."
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).
Codice: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
Nessun problema rollis,
hai fatto benissimo ad intervenire ;)
"Sono le persone che nessuno immagina che possano fare certe cose, quelle che fanno cose che nessuno può immaginare."
Questa la mia "versione":
Come per quella modificata da @rollis13, ci si posiziona sopra la cella col "testo intero" e si avvia la macro.Codice: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
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![]()
"Sono le persone che nessuno immagina che possano fare certe cose, quelle che fanno cose che nessuno può immaginare."
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.
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.
Non so come ringraziarvi! Funziona alla grande!
Unico appunto: su un file già esistente, come faccio a far partire la macro?
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.
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!
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...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!
Ultima modifica fatta da:scossa; 20/09/16 alle 23:20
Fatto tutto! smanettando sono riuscito anche a non perdere il restante! comincio ad appassionarmi!
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...Codice: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
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.
Codice:da: Limite = InputBox("Inserire numero massimo di caratteri", "NUMERO CARATTERI") a: Limite = 20 'indicare il numero di caratteri
@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 ?
Ah, ecco, era solo perché già sapevo cosa avevo scritto e non serviva ripetermelo, mica sono sordo
.
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:
E' una udf matriciale: testo in A1, selezionare le 4 o 5 celle dove si vuole il risultato ed inserire::Codice: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
=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.
Ultima modifica fatta da:scossa; 20/09/16 alle 23:36
Bye!
scossa
scossa's web site
___
Se tu hai una mela, e io ho una mela, e ce le scambiamo, allora tu ed io abbiamo sempre una mela per uno. Ma se tu hai un'idea, ed io ho un'idea, e ce le scambiamo, allora abbiamo entrambi due idee. (George Bernard Shaw)
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))))
Bye!
scossa
scossa's web site
___
Se tu hai una mela, e io ho una mela, e ce le scambiamo, allora tu ed io abbiamo sempre una mela per uno. Ma se tu hai un'idea, ed io ho un'idea, e ce le scambiamo, allora abbiamo entrambi due idee. (George Bernard Shaw)
grazie!
scusa rollis13!
Condividi nei tuoi social!