Dividere contenuto cella in più celle Excel
Ho bisogno di dividere le celle presenti nel file allegato, dove per ogni cella deve corrispondere un fondo. Con lo strumento “testo in colonne” non riesco perché essendo il contenuto della cella “testo a capo” e come se tutti i nomi dei fondi fossero uniti e quindi senza spazi.
Soluzione 1: sub() costruita e poi adattata con il registratore di macro da inserire nel foglio in questione.
Procedura:
1 crea un nuovo testo dove al posto di ritorno a capo metto un altro simbolo
2 copio la colonna B:B modificata in C:C solo valori
3 sulla colonna C:C eseguo il comando — testo in colonne — confermando quello che mi viene richiesto
Sub Macro1() Range("B1").Select ActiveCell.FormulaR1C1 = "=SUBSTITUTE(RC[-1],CHAR(10),"""")" Range("B1").Select Selection.Copy Range("B1:B" & Cells(Rows.Count, 1).End(xlUp).Row).Select ActiveSheet.Paste Columns("B:B").Select Application.CutCopyMode = False Selection.Copy Columns("C:C").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _ Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _ :="", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), _ TrailingMinusNumbers:=True End Sub |
Soluzione2:
Option Explicit Sub splitta() Dim vSplit As Variant Dim i As Long, x As Long, k As Long, z As Long x = Range("A" & Rows.Count).End(xlUp).Row For i = 2 To x vSplit = Split(Cells(i, 1), Chr(10)) If UBound(vSplit) > 0 Then For k = 0 To UBound(vSplit) z = Range("B" & Rows.Count).End(xlUp).Row + 1 Cells(z, 2) = vSplit(k) Next k Else z = Range("B" & Rows.Count).End(xlUp).Row + 1 Cells(z, 2) = vSplit(0) End If Next i End Sub Soluzione3:
Sub test() Dim R As Long, I As Long, S As Variant, Cella As Range Application.ScreenUpdating = False R = 2 For Each Cella In Range("A2", Range("A2").End(xlDown)) S = Split(Cella, vbLf) For I = LBound(S) To UBound(S) Cells(R, 2) = S(I) R = R + 1 Next I Next Cella Application.ScreenUpdating = True End Sub