Данные Spit в одной ячейке в несколько строк

Question

У меня есть набор данных с именами и адресами в файле Excel в следующем формате.

Name1 
    134/47/1, 
adrs1, adr2, country 

Name2 
adrs1, adrs2, country 

Name3 
    107/c, 
adrs3, adrs3, country 

etc… 

Я хочу, чтобы разделить эти данные в несколько строк в следующем формате

Name1 
    134/47/1, 
adrs1, 
adrs2, 
country 

Name2 
No 134/63, 
adrs1, 
adrs2, 
country 


etc… 

Я попытался следующие, но он работал только для одной строки ячейки.

Sub tst() 
    Dim X As Variant 
    X = Split(Range("A1").Value, ",") 
    Range("A1").Resize(UBound(X) - LBound(X) + 1).Value =   Application.Transpose(X) 
End Sub 

Answer 1

Я не уверен, были ли конечный ваши данные выборки запятые на отдельных значениях опечатки или, если это то, что точно отражает ваши данные, но которые должны быть учтены. Мошенническая запятая в качестве суффикса создаст дополнительный элемент для варианта массива, тем самым отбрасывая размеры, созданные путем ссылки на UBound function.

Sub split_from_below_space() 
    Dim rw As Long, v As Long, vVALs As Variant 

    With Worksheets("Sheet1") 'set this worksheet reference properly! 
     For rw = .Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1 
      .Cells(rw, 1) = Trim(.Cells(rw, 1).Value2) 
      If CBool(InStr(1, .Cells(rw, 1).Value2, Chr(44) & Chr(32))) Then 
       vVALs = Split(.Cells(rw, 1).Value2, Chr(44) & Chr(32)) 
       .Cells(rw + 1, 1).Resize(UBound(vVALs), 1).EntireRow.Insert 
       .Cells(rw, 1).Resize(UBound(vVALs) + 1, 1) = _ 
        Application.Transpose(vVALs) 
       For v = UBound(vVALs) - 1 To LBound(vVALs) Step -1 
        .Cells(rw, 1).Offset(v, 0) = _ 
         Trim(.Cells(rw, 1).Offset(v, 0).Value2) & Chr(44) 
       Next v 
      End If 
     Next rw 
    End With 

End Sub 

Вам нужно будет вставлять строки для размещения данных и этот метод почти всегда (как в данном случае) лучше выполняется, работая от дна к вершине.

Answer 2

Следующий макрос может вам помочь. Вам нужно будет выбрать самую последнюю ячейку в вашей таблице, содержащую многостраничный адрес. Когда вы запустите макрос, он будет прокладывать путь вверх и вставить строки адреса там, где это необходимо (только в текущем столбце), а затем выйти.

Option Base 1 
Sub trnsfrm() 
    Dim i%, n%, ret(3, 1) 
    Set r = Selection 
    Do 
    a = Split(r, ",") 
    ret(1, 1) = Trim(a(0)) 
    ret(2, 1) = Trim(a(1)) 
    ret(3, 1) = Trim(a(2)) 
    r.Range([a2], [a3]).Insert Shift:=xlDown 
    r.Range([a1], [a3]) = ret 
    If r.Row <= 4 Then Exit Do 
    Set r = r.Offset(-4) 
    Loop 
End Sub 

Если вы хотите вставить линии через всю таблицу, вы должны заменить строку (10)

r.Range([a2], [a3]).Insert Shift:=xlDown 

по

r.Range([a2], [a3]).EntireRow.Insert Shift:=xlDown 

Предположения/Предупреждение

С макрос фактически изменит вашу текущую таблицу и «отменит» не работает с макросами, вы должны обязательно сохранить все, прежде чем попробовать.

Макрос предполагает, что каждый блок адрес состоит из ровно 4 линий. Если на адрес будет меньше или больше строк, маро выйдет из строя и, скорее всего, выведет мусор или остановится.