在分隔符处分割并添加到新行
我在Excel中有以下数据：
并想结束与类似于下面的东西： 
有相当多的数据来操纵，所以我寻求最有效的方式来做到这一点，实质上包括：
- search列
Region为- - 如果find，从开始
-直到下一个实例-或end of cell抓取数据 - 将数据复制到伴随扩展数据的新行中（按照第二个屏幕截图）
- 循环
请让我知道是否需要进一步的信息，并提前谢谢
原始数据如下：
Current: State Region Type Frequency Region Time Selected Medians and Averages Value New South Wales Statistical Area Level 2 Annual Eden 2011 Median age of persons 47 New South Wales Statistical Area Level 2 Annual Eurobodalla Hinterland 2011 Median age of persons 48 New South Wales Statistical Area Level 2 Annual Merimbula - Tura Beach - Moss Beach 2011 Median age of persons 51 New South Wales Statistical Area Level 2 Annual Moruya - Tuross Head 2011 Median age of persons 50 Proposed: State Region Type Frequency Region Time Selected Medians and Averages Value New South Wales Statistical Area Level 2 Annual Eden 2011 Median age of persons 47 New South Wales Statistical Area Level 2 Annual Eurobodalla Hinterland 2011 Median age of persons 48 New South Wales Statistical Area Level 2 Annual Merimbula 2011 Median age of persons 51 New South Wales Statistical Area Level 2 Annual Tura Beach 2011 Median age of persons 51 New South Wales Statistical Area Level 2 Annual Moss Beach 2011 Median age of persons 51 New South Wales Statistical Area Level 2 Annual Moruya 2011 Median age of persons 50 New South Wales Statistical Area Level 2 Annual Tuross Head 2011 Median age of persons 50
只有活动工作表上的当前数据和A1中的状态，运行此macros。
Sub split_and_create() Dim rw As Long, lr As Long, lc As Long, v As Long, vSTATs As Variant, vREGNs As Variant With ActiveSheet lr = .Cells(Rows.Count, 1).End(xlUp).Row lc = .Cells(1, Columns.Count).End(xlToLeft).Column .Cells(1, 2).CurrentRegion.Rows(1).Copy _ Destination:=.Cells(lr + 2, 1) For rw = 2 To lr vSTATs = Application.Index(.Cells(rw, 1).Resize(1, lc).Value, 1, 0) vREGNs = Split(vSTATs(4), " - ") For v = LBound(vREGNs) To UBound(vREGNs) vSTATs(4) = vREGNs(v) .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, lc) = vSTATs Next v Next rw End With End Sub
build议的结果应该在Current下面填充。
