一次拆分会，两次拆分不会，大侠们帮帮忙

huangkepan

一次拆分会，两次拆分不会，大侠们帮帮忙

序号	地区	数量			序号	地区	数量
1	广东、福建、湖南、上海	3、6、5、8			1	广东	3
2	西藏	2	file:///C:/Users/27762/AppData/Local/Temp/msohtmlclip1/01/clip_image002.png			福建	4
3	云南、新疆、贵州	1、4、5				湖南	5
4	北京、河南	3、1				上海	8
					2	西藏	2
					3	云南	1
						新疆	4
						贵州	5
					4	北京	3
						河南	1

hfwufanhf2006

Range(Cells(2, 6), Cells([h10000].End(3).Row, 8)).Delete Shift:=xlUp       '删除原有表格
hs = 2   '从第2行开始显示，第1行是标题
For i = 2 To [a10000].End(3).Row
    s1 = Split(Cells(i, 2), "、")
    s2 = Split(Cells(i, 3), "、")
    js = hs
    For k = 0 To UBound(s1)
        If k = 0 Then
           Cells(hs, 6) = Cells(i, 1)
        End If
        Cells(hs, 7) = s1(k)
        Cells(hs, 8) = s2(k)
        hs = hs + 1
    Next k
    If UBound(s1) > 0 Then
       Range(Cells(js, 6), Cells(hs - 1, 6)).Merge    '大于1个单位就合并单元格
    End If
Next i

Range(Cells(2, 6), Cells([h10000].End(3).Row, 8)).Select    '下面是划表格线，在录制宏基础上简化而来
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous
Selection.Borders(xlEdgeTop).LineStyle = xlContinuous
Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous
Selection.Borders(xlEdgeRight).LineStyle = xlContinuous
Selection.Borders(xlInsideVertical).LineStyle = xlContinuous
Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous
Range("f1").Select

aidunsoft

用艾敦制表神器插件数据行拆分一键解决  

https://www.aidunsoft.com/photo/show-76.html