[已解决]如何快速对excel中多个单元格的内容进行分行？

kangkangtianxia

如何快速对excel中多个单元格（两个）的内容进行分行？详细见附件。。谢谢！

最佳答案

月排行榜 / 总排行榜

dsmch

2015-2-11 13:50

1. Sub Macro1()
   
2. Dim arr, brr, i&, s&, j%
   
3. arr = Sheet1.Range("a1").CurrentRegion
   
4. ReDim brr(1 To 20000, 1 To UBound(arr, 2))
   
5. For i = 1 To UBound(arr)
   
6.     x = Split(arr(i, 3), "、")
   
7.     y = Split(arr(i, 4), "/")
   
8.     For j = 0 To UBound(x)
   
9.         s = s + 1
   
10.         brr(s, 1) = arr(i, 1)
    
11.         brr(s, 2) = arr(i, 2)
    
12.         brr(s, 3) = x(j)
    
13.         brr(s, 4) = y(j)
    
14.     Next
    
15. Next
    
16. Sheet2.Activate
    
17. ActiveSheet.UsedRange.Clear
    
18. With Range("a1").Resize(s, 4)
    
19.     .Value = brr
    
20.     .Borders.LineStyle = 1
    
21. End With
    
22. End Sub

复制代码

跳转到最佳答案楼层

kangkangtianxia

忘了上附件。。谢谢！

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, i&, s&, j%
   
3. arr = Sheet1.Range("a1").CurrentRegion
   
4. ReDim brr(1 To 20000, 1 To UBound(arr, 2))
   
5. For i = 1 To UBound(arr)
   
6.     x = Split(arr(i, 3), "、")
   
7.     y = Split(arr(i, 4), "/")
   
8.     For j = 0 To UBound(x)
   
9.         s = s + 1
   
10.         brr(s, 1) = arr(i, 1)
    
11.         brr(s, 2) = arr(i, 2)
    
12.         brr(s, 3) = x(j)
    
13.         brr(s, 4) = y(j)
    
14.     Next
    
15. Next
    
16. Sheet2.Activate
    
17. ActiveSheet.UsedRange.Clear
    
18. With Range("a1").Resize(s, 4)
    
19.     .Value = brr
    
20.     .Borders.LineStyle = 1
    
21. End With
    
22. End Sub

复制代码

26759761@qq.com

1. Sub x()
   
2. Dim ar, x, k, k1, ar1, arr, ar2(1 To 10000, 1 To 4)
   
3. With Sheets("目标结果")
   
4. .Columns("a:d").Clear
   
5. arr = Range("a2").CurrentRegion
   
6.   For x = 1 To UBound(arr)
   
7.     ar = Split(arr(x, 3), "、")
   
8.     ar1 = Split(arr(x, 4), "/")
   
9.      For k = 0 To UBound(ar)
   
10.       k1 = k1 + 1
    
11.        ar2(k1, 1) = arr(x, 1): ar2(k1, 2) = arr(x, 2)
    
12.        ar2(k1, 3) = ar(k): ar2(k1, 4) = ar1(k)
    
13.       Next
    
14.    Next
    
15.   .[a1].Resize(k1, 4) = ar2
    
16.   .UsedRange.Borders.LineStyle = 1
    
17.   MsgBox "分列完毕"
    
18.   .Select
    
19. End With
    
20. End Sub
    

复制代码

suye1010

看到了VBA的做法，我再贡献一个函数的思路
Copy of 如何将多个单元格的多个数据进行分行？.zip (4.65 KB, 下载次数: 3)

2015-2-11 14:40 上传

点击文件名下载附件

kangkangtianxia

dsmch 发表于 2015-2-11 13:50

请问为什么我的这个表运行起来会出现“下界越标”？？

dsmch

第13行数据，前后数据不匹配
在首行增加一句纠错代码：On Error Resume Next

kangkangtianxia

dsmch 发表于 2015-2-11 21:04
第13行数据，前后数据不匹配
在首行增加一句纠错代码：On Error Resume Next

完美解决了问题。。谢谢！