Ingegneria Forum
Ingegneria Edile, Strutturale & Geotecnica => .:C#, Excel, VB e Programmazione:. => Topic started by: gastab on 04 May , 2014, 15:28:23 PM
-
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?
-
Con una sub (Macro :doh:) puoi fare così:
https://app.box.com/s/7xnmjlpculhzw4cfr7z5 (https://app.box.com/s/7xnmjlpculhzw4cfr7z5)
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
-
Con una sub (Macro :doh:) puoi fare così:
https://app.box.com/s/7xnmjlpculhzw4cfr7z5 (https://app.box.com/s/7xnmjlpculhzw4cfr7z5)
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!