Страницы: 1
RSS
Текст из ячейки разнести на строки
 
Здравствуйте, подскажите, пожалуйста. Имеется большой документ. В одной колонке в каждой ячейке много данных, расположенных в столбик, надо  их разбить на строки. картинку прилагаю
 
Код
Sub Main()
    SplitCell Range("E2")
    SplitCell Range("E1")
End Sub

Sub SplitCell(cl As Range)
    Dim s As String
    s = cl.Cells(1).Value
    Dim arr As Variant
    arr = Split(s, vbLf)
    If IsArray(arr) Then
        Dim sh As Worksheet
        Set sh = cl.Parent
        Dim i As Long
        Dim y As Long
        Dim x As Integer
        y = cl.Row
        For i = UBound(arr) To 1 Step -1
            cl.Cells(2, 1).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            cl.Cells(2, 1).Value = arr(i)
            For x = sh.UsedRange.Column To sh.UsedRange.Column + sh.UsedRange.Columns.Count - 1
                If x <> cl.Column Then
                    sh.Cells(y, x).Resize(2, 1).Merge
                End If
            Next
            cl.Cells(1, 1).Value = arr(0)
        Next
    End If
End Sub
 
Спасибо большое! Очень помогли!
Страницы: 1
Наверх