Author Topic: Dividere il testo contenuto in una cella di excel e riportarlo su più righe  (Read 6111 times)

0 Members and 1 Guest are viewing this topic.

gastab

  • Guest
Come da titolo ho la necessità di dividere una stringa di testo abbastanza lunga (tipo comma di una normativa) contenuta in una sola cella di excel e riportarla nello stesso foglio (o anche in un altro) su più righe, per effettuare successivamente un conteggio delle righe così riempite.

Sapete indicarmi come fare, eventualmente senza ricorrere a macro?


Offline quattropassi

  • Esperto del forum
  • ***
  • Posts: 226
  • Karma: 49
  • Neo - Laureato
Con una sub (Macro  :doh:) puoi fare così:
https://app.box.com/s/7xnmjlpculhzw4cfr7z5

Code: [Select]
Sub JustDoIt_2()
'http://stackoverflow.com/questions/19851951/microsoft-excel-split-text-in-cells-at-line-breaks
    'working for active sheet
    'copy to the end of sheets collection
   
    ActiveSheet.Copy after:=Sheets(Sheets.Count)
    Dim SelezionRange As Range 'Dimensiono una variabile range
    Dim tmpArr As Variant
    Dim Cell As Range
   
    Set SelezionRange = Range(Selection, Selection) 'Il range lo definisco attraverso la cella selezionata

    For Each Cell In Range(SelezionRange, SelezionRange.Offset(1, 0).End(xlDown)) 'scendo una riga e vado all'ultima riga libera
        If InStr(1, Cell, Chr(10)) <> 0 Then 'Cerco la stringa ritorno carrello (a capo)
            tmpArr = Split(Cell, Chr(10)) 'Spacco la stringa all a capo e memorizzo nel vettore tmpArr
            Cell.EntireRow.Copy
            Cell.Offset(1, 0).Resize(UBound(tmpArr), 1). _
            EntireRow.Insert xlShiftDown
            Cell.Resize(UBound(tmpArr) + 1, 1) = Application.Transpose(tmpArr)
        End If
    Next
   
    Application.CutCopyMode = False
End Sub
* Se ci scambiamo un dollaro, ognuno rimane con un dollaro.
* Se ci scambiano un'informazione, ognuno rimane con due informazioni.

gastab

  • Guest
Con una sub (Macro  :doh:) puoi fare così:
https://app.box.com/s/7xnmjlpculhzw4cfr7z5

Code: [Select]
Sub JustDoIt_2()
'http://stackoverflow.com/questions/19851951/microsoft-excel-split-text-in-cells-at-line-breaks
    'working for active sheet
    'copy to the end of sheets collection
   
    ActiveSheet.Copy after:=Sheets(Sheets.Count)
    Dim SelezionRange As Range 'Dimensiono una variabile range
    Dim tmpArr As Variant
    Dim Cell As Range
   
    Set SelezionRange = Range(Selection, Selection) 'Il range lo definisco attraverso la cella selezionata

    For Each Cell In Range(SelezionRange, SelezionRange.Offset(1, 0).End(xlDown)) 'scendo una riga e vado all'ultima riga libera
        If InStr(1, Cell, Chr(10)) <> 0 Then 'Cerco la stringa ritorno carrello (a capo)
            tmpArr = Split(Cell, Chr(10)) 'Spacco la stringa all a capo e memorizzo nel vettore tmpArr
            Cell.EntireRow.Copy
            Cell.Offset(1, 0).Resize(UBound(tmpArr), 1). _
            EntireRow.Insert xlShiftDown
            Cell.Resize(UBound(tmpArr) + 1, 1) = Application.Transpose(tmpArr)
        End If
    Next
   
    Application.CutCopyMode = False
End Sub
Grazie! La testerò e ti farò sapere!

 

Sitemap 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24