在分隔符处拆分并添加到新行

Question

我在Excel中有以下数据：

​

​

并希望最终得到类似于以下内容的东西：

​

有相当多的数据需要处理，所以我寻求最有效的方法，实质上它将涉及：

• 在列Region中搜索-
• 如果找到，获取从-开始到下一个-或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

Answer 1

使用A1中的活动工作表和状态中的当前数据，运行此宏。

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

所提议的结果应与目前类似。

​