拆分单元格并插入行

黑山上的鹰

求助：将拆分源数据表A列单元格内容，并将拆分结果放在下面行（插入行），结果如结果表。谢谢！

一执成念

VBA板块分分钟解决，或者用PQ

cnmlgb9998

公式也能解决啊。textsplit 不是分分钟能搞定？简单，不想做了

杨建营

请楼主参考。

杨建营

1. Sub splita()
   
2. Dim i&, j&, k&, m&
   
3. Dim arr, brr, ar
   
4. Application.ScreenUpdating = False
   
5. With Sheets("源表")
   
6.     arr = .[a1].CurrentRegion
   
7.     ReDim brr(1 To 10000, 1 To 7)
   
8.     For i = 1 To UBound(arr)
   
9.         If InStr(arr(i, 1), "、") Then
   
10.             ar = Split(arr(i, 1), "、")
    
11.             For j = 0 To UBound(ar)
    
12.                 k = k + 1
    
13.                 brr(k, 1) = ar(j)
    
14.                 For m = 2 To 7
    
15.                     brr(k, m) = arr(i, m)
    
16.                 Next
    
17.             Next
    
18.         Else
    
19.             k = k + 1
    
20.             For m = 1 To 7
    
21.                 brr(k, m) = arr(i, m)
    
22.             Next
    
23.         End If
    
24.     Next
    
25. End With
    
26. With Sheets("结果").[k1]
    
27.     .Resize(k, 7) = brr
    
28.     With .CurrentRegion
    
29.         .Borders.LineStyle = 1
    
30.         .HorizontalAlignment = xlCenter
    
31.     End With
    
32.     .Range("A:A").HorizontalAlignment = xlLeft
    
33. End With
    
34. Application.ScreenUpdating = True
    
35. End Sub
    

复制代码

代码如上。

ynzsvt

1. Sub 拆分()
   
2. Dim Arr, i&, Crr
   
3. Dim Brr(), j&, k&, L&
   
4. With Worksheets("源表")
   
5.   Arr = .[a1].CurrentRegion
   
6. End With
   
7. 
   
8. With Worksheets("结果")
   
9.   ReDim Brr(1 To 999, 1 To UBound(Arr, 2)) '999为足够大的空间存放结果
   
10.   j = 0
    
11.   For i = 1 To UBound(Arr)
    
12.    Crr = Split(Arr(i, 1), "、")
    
13.    For L = 0 To UBound(Crr)
    
14.     j = j + 1
    
15.     Brr(j, 1) = Crr(L)
    
16.     For k = 2 To UBound(Arr, 2): Brr(j, k) = Arr(i, k): Next k
    
17.    Next 'L
    
18.   Next 'i
    
19.   .[a1].Resize(j, UBound(Arr, 2)) = Brr
    
20. End With
    
21. End Sub

复制代码

黑山上的鹰

杨建营 发表于 2024-12-1 16:08
代码如上。

感谢，楼下代码最精简。

黑山上的鹰

ynzsvt 发表于 2024-12-1 16:09

感谢！就是这样。