DIVIDI TESTO IN COLONNE

Hai un problema con Excel?

Nuova discussione

DIVIDI TESTO IN COLONNE
di robybarc data: 22/10/2015 10:54:43
Ciao a tutti,
questa macro mi divide il testo della colonna B partendo dalla colonna T, non riesco a fargli dividere il testo delle colonne successive partendo dalla C scrivendole dalla prima cella libera dopo la colonna T della stessa riga, e cosi via fino alla colonna E.
le celle da splittare ( colonna B, C, D, ecc. ) possono anche essere vuote.
Inoltre tutte le celle splittate devo trasformarle in MAIUSCOLO.

Allego file di esempio

Grazie
Roberto

Sub Dividi()
    Workbooks("DividiTesto.xlsm").Activate
    Sheets("Foglio1").Select
r = 1 'riga di lettura
r1 = 1 'riga di scrittura
 Do Until Cells(r, 2) = ""
    mSplit = Split(Replace(Cells(r, 2).Value, "/", " "), " ")
    C = 20 'colonna inizio scrittura
    For i = 0 To UBound(mSplit)
       Cells(r1, C) = mSplit(i)
       C = C + 1
    Next i
    r = r + 1
    r1 = r1 + 1
 Loop
End Sub

di isy data: 22/10/2015 11:36:05
Ciao

Cit: Inoltre tutte le celle splittate devo trasformarle in MAIUSCOLO.

Puoi per cortesia allegare un file che mostri il risultato atteso
Specifica meglio come si distribuiscono i dati in caso di colonne vuote
di robybarc data: 22/10/2015 14:54:46
Ciao Isy
ti ho allegato il file DividiTesto2.xlsm di come deve essere il risultato
Grazie
Roberto

di Mister_x (utente non iscritto) data: 22/10/2015 16:46:25
ciao

buttato al macero la tua sub()
ti propongo questa

PS le variabili bisogna sempre dichiararle

ciao

Option Explicit
Sub Dividi()
Dim Ncol As Long, i As Long
Dim Stringa As String, StrS As Variant
Dim Str_S As Variant
   Sheets("Foglio2").Select
For i = 1 To Cells(Rows.Count, 2).End(xlUp).Row
  Stringa = Cells(i, 2) & " " & Cells(i, 3) & " " & Cells(i, 4) & " " & Cells(i, 5)
  StrS = Split(Stringa, " ", -1)
 Ncol = 20
  For Each Str_S In StrS
    Cells(i, Ncol) = Str_S
    Ncol = Ncol + 1
  Next
Next i
End Sub

di Albatros54 data: 22/10/2015 16:51:54
Ho recuperato dal macero la sub()
Ciao

Sub Dividi()
    Workbooks("DividiTesto2.xlsm").Activate
    Sheets("Foglio1").Select
r = 1 'riga di lettura
r1 = 1 'riga di scrittura
a = 2
C = 20 'colonna inizio scrittura
 Do Until Cells(r, a) = ""
 For a = 2 To 6
    mSplit = Split(Replace(Cells(r, a).Value, "/", " "), " ")
    
    For i = 0 To UBound(mSplit)
       Cells(r1, C) = mSplit(i)
       C = C + 1
    Next i
   Next a
    r = r + 1
    r1 = r1 + 1
    a = 2
    C = 20
 Loop
End Sub

di Mister_x (utente non iscritto) data: 22/10/2015 17:18:23
ciao

dichiarare le Variabili

perché tanto spreco???

ciao

Option Explicit
Sub Dividi()
Dim r As Long, C As Long, a As Long, i As Long
Dim mSplit As Variant
Sheets("Foglio1").Select
r = 1 'riga di lettura e scrittura
C = 20 'colonna inizio scrittura
 Do Until Cells(r, 2) = ""
 For a = 2 To Cells(Rows.Count, 2).End(xlUp).Row ''Tot righe da trattare
    mSplit = Split(Replace(Cells(r, a).Value, "/", " "), " ")
  For i = 0 To UBound(mSplit)
       Cells(r, C) = UCase(mSplit(i))
       C = C + 1
  Next i
 Next a
    r = r + 1
    C = 20
 Loop
End Sub

di robybarc data: 22/10/2015 18:05:20
Grazie sia a Mister_x che ad Albatros54,
Le vostra macro funzionano alla perfezione, sono impostate in modo diverso e cercherò di studiarmele per capere qualcosa di più di VBA,
adesso devo rendere le celle copiate tutte in MAIUSCOLO, io ho cercato di adattare la macro sotto ma credo che ci sia un'istruzione più semplice che possa dare lo stesso risultato,
allego il file DividiTesto3.xlsm per rendere l'idea.
Grazie
Roberto

Sub TuttoMaiusc()
Application.ScreenUpdating = False
    Workbooks("DividiTesto3.xlsm").Activate
    Sheets("Foglio1").Select
    Range("T1").Select
ContinuaMaiusc:
    ActiveWorkbook.Names.Add Name:= _
        "MaiuscText", RefersTo:=Selection
If Range("MaiuscText") = "" Then
     GoTo FineMaiusc
Else
For K = 1 To 7
    Range("MaiuscText").Select
    ActiveCell.Resize(1, 20).Copy
    Range("B18").Select
    Selection.PasteSpecial Paste:=xlPasteAll
    Range("B17:U17").Copy
    Range("MaiuscText").Select
    Selection.PasteSpecial Paste:=xlPasteValues, _
             Operation:=xlNone, SkipBlanks _
             :=False, Transpose:=False
    ActiveCell.Offset(1, 0).Select
    GoTo ContinuaMaiusc
Next
End If
FineMaiusc:
    Application.CutCopyMode = False
 End Sub

di Mister_x (utente non iscritto) data: 22/10/2015 18:14:45
ciao

la funzione Ucase() che io ho dimenticato nel mio intervento ma che ho messo nell'ultima sub() di albatros
Cells(r, C) = UCase(mSplit(i))

nella mia da cosi'
Cells(i, Ncol) = Str_S
a cosi
Cells(i, Ncol) = UCase(Str_S)

ciao
di robybarc data: 23/10/2015 10:31:28
ottimo accorgimento,
meglio non potrebbe funzionare.
Grazie
Roberto

Vuoi Approfondire?