Divide um grande número de linhas em uma única coluna para várias colunas

0

Eu tenho 1542 linhas em uma única coluna.

Eu gostaria de dividir isso em várias colunas com o mesmo número # ou próximo ao mesmo número de linhas em cada coluna. Também, se possível, seja capaz de fazer isso de maneiras diferentes ...

i.e. divida-o em colunas de 4,5,6 ou mais meus dados são endereços IP, então seria texto em cada célula abaixo está uma amostra dos meus dados

10.11.6.1
10.11.8.1
10.11.11.1
10.11.22.1
10.11.26.1
10.11.32.1
10.11.35.1
10.11.38.1
10.18.8.1
10.18.14.1
10.18.19.1
10.18.24.1
10.18.25.1
10.18.27.1
10.18.73.1
10.18.86.1
10.18.88.1
10.19.8.1
10.19.19.1
10.19.29.1
10.19.31.1
10.19.43.1
10.19.54.1
10.19.57.1
10.19.65.1
    
por Joshua Goodman 13.02.2017 / 18:02

2 respostas

0

Um simples script vba para pegar o valor em uma célula selecionada e dividi-lo em células separadas é:

Sub Macro1()
    Dim rCell As Range, cString As String, cr As String
    Set rCell = Selection(1)
    a = rCell.Value
    cr = Chr(13)
    If InStr(a, cr) > 0 Then
        ary = Split(a, cr)
        For i = 1 To UBound(ary)
            rCell.Offset(1, 0).EntireRow.Insert
        Next i
        For i = 0 To UBound(ary)
            rCell.Offset(i, 0).Value = ary(i)
        Next i
    End If

End Sub

Esta macro encontra char (13), retorno de carro e adiciona nova célula com base em encontrá-lo. Se isso não funcionar, você pode ter char (10), feeds de linha, então apenas mude o número na macro.

Esta macro é plagiada em parte de outras postagens deste e de outros fóruns

    
por 13.02.2017 / 18:53
0

Experimente:

Sub marine()
    Dim i As Long, j As Long, k As Long
    Dim v As String, Old As String
    Dim N As Long

    N = Cells(Rows.Count, "A").End(xlUp).Row
    j = 2
    i = 1
    Cells(1, 2) = Cells(1, 1)
    Old = Split(Cells(i, 1), ".")(1)

    For k = 2 To N
        v = Cells(k, 1).Value
        If Split(v, ".")(1) <> Old Then
            j = j + 1
            i = 1
            Old = Split(v, ".")(1)
        Else
            i = i + 1
        End If
        Cells(i, j) = v
    Next k
End Sub

    
por 13.02.2017 / 19:19