[已解决]拆分后转置.rar

水木

救助：拆分后转置.rar (11.39 KB, 下载次数: 6)

2014-10-14 11:14 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

qh8600

2014-10-14 11:54

1. Sub demo()
   
2.     Dim arr, brr(), i As Long, j As Long, n As Long
   
3.     arr = Sheets("原数据").Range("a2:f" & Sheets("原数据").Cells(Rows.Count, 1).End(xlUp).Row)
   
4.     ReDim brr(1 To 1000, 1 To 7)
   
5.     For i = 1 To UBound(arr)
   
6.         crr = Split(arr(i, 6), "/")
   
7.         For j = 0 To UBound(crr) - 1
   
8.             n = n + 1
   
9.             brr(n, 1) = arr(i, 1)
   
10.             brr(n, 2) = arr(i, 2)
    
11.             brr(n, 3) = arr(i, 3)
    
12.             brr(n, 4) = arr(i, 4)
    
13.             brr(n, 5) = arr(i, 5)
    
14.             brr(n, 6) = Split(crr(j), "、")(0)
    
15.             brr(n, 7) = Split(crr(j), "、")(1)
    
16.         Next
    
17.     Next
    
18.     Sheets("重排").Range("a2").Resize(n, 7) = brr
    
19. End Sub
    

复制代码

救助：拆分后转置.rar (18.75 KB, 下载次数: 28)

2014-10-14 11:54 上传

点击文件名下载附件
楼主试试

跳转到最佳答案楼层

qh8600

1. Sub demo()
   
2.     Dim arr, brr(), i As Long, j As Long, n As Long
   
3.     arr = Sheets("原数据").Range("a2:f" & Sheets("原数据").Cells(Rows.Count, 1).End(xlUp).Row)
   
4.     ReDim brr(1 To 1000, 1 To 7)
   
5.     For i = 1 To UBound(arr)
   
6.         crr = Split(arr(i, 6), "/")
   
7.         For j = 0 To UBound(crr) - 1
   
8.             n = n + 1
   
9.             brr(n, 1) = arr(i, 1)
   
10.             brr(n, 2) = arr(i, 2)
    
11.             brr(n, 3) = arr(i, 3)
    
12.             brr(n, 4) = arr(i, 4)
    
13.             brr(n, 5) = arr(i, 5)
    
14.             brr(n, 6) = Split(crr(j), "、")(0)
    
15.             brr(n, 7) = Split(crr(j), "、")(1)
    
16.         Next
    
17.     Next
    
18.     Sheets("重排").Range("a2").Resize(n, 7) = brr
    
19. End Sub
    

复制代码

救助：拆分后转置.rar (18.75 KB, 下载次数: 28)

2014-10-14 11:54 上传

点击文件名下载附件
楼主试试

水木

qh8600 发表于 2014-10-14 11:54
楼主试试

要求是以后1、2、3、4、5、6、7、8、9、10、11……/，为一段，以“1、”为一字符，但文中若有“、”号的句子，却不能够完事地保存，而是丢了。如3、“精通绘画、音乐、戏剧、书法、篆刻和诗词，”后面的“音乐、戏剧、书法、篆刻和诗词，”就没有了。

qh8600

水木 发表于 2014-10-14 13:20
要求是以后1、2、3、4、5、6、7、8、9、10、11……/，为一段，以“1、”为一字符，但文中若有“、”号的句 ...

1. Sub demo()
   
2.     Dim arr, brr(), i As Long, j As Long, n As Long
   
3.     arr = Sheets("原数据").Range("a2:f" & Sheets("原数据").Cells(Rows.Count, 1).End(xlUp).Row)
   
4.     ReDim brr(1 To 1000, 1 To 7)
   
5.     For i = 1 To UBound(arr)
   
6.         crr = Split(arr(i, 6), "/")
   
7.         For j = 0 To UBound(crr) - 1
   
8.             n = n + 1
   
9.             brr(n, 1) = arr(i, 1)
   
10.             brr(n, 2) = arr(i, 2)
    
11.             brr(n, 3) = arr(i, 3)
    
12.             brr(n, 4) = arr(i, 4)
    
13.             brr(n, 5) = arr(i, 5)
    
14.             brr(n, 6) = Split(Replace(crr(j), "、", "-", , 1), "-")(0)
    
15.             brr(n, 7) = Split(Replace(crr(j), "、", "-", , 1), "-")(1)
    
16.         Next
    
17.     Next
    
18.     Sheets("重排").Range("a2").Resize(n, 7) = brr
    
19. End Sub
    

复制代码

这样试试

wensc

水木 发表于 2014-10-14 13:20
要求是以后1、2、3、4、5、6、7、8、9、10、11……/，为一段，以“1、”为一字符，但文中若有“、”号的句 ...

红色字体好像没有不能保持原格式了吧