Excel中VBA将单元格中多行数据分行处理

yjwdjfqb

Excel中VBA将单元格中多行数据分行处理
老师们好，请帮帮VBA代码处理下一个单元格多行数据问题
如图：
请老师们帮写个VBA代码，谢谢老师们了！

Excel中VBA将单元格中多行数据分行处理.rar (6.48 KB, 下载次数: 24)

2019-12-12 21:27 上传

点击文件名下载附件

exyantou

1. Sub 拆分()
   
2.   Dim arr1, arr2, arr3(1 To 10 ^ 6, 1 To 3) As String
   
3.   Dim x%, y%, z%
   
4.   Dim rng
   
5.   On Error GoTo 100
   
6.   arr1 = ThisWorkbook.Worksheets(1).Range("A2:C" & ThisWorkbook.Worksheets(1).[a65536].End(xlUp).Row)
   
7.   z = 1
   
8.   arr3(1, 1) = "姓名": arr3(1, 2) = "性别": arr3(1, 3) = "课目"
   
9.   For x = 1 To UBound(arr1)
   
10.     If InStr(arr1(x, 3), Chr(10)) > 0 Then
    
11.       arr2 = Split(arr1(x, 3), Chr(10))
    
12.         For y = 0 To UBound(arr2)
    
13.           z = z + 1
    
14.           If y = 0 Then
    
15.             arr3(z, 3) = arr2(y)
    
16.             arr3(z, 1) = arr1(x, 1)
    
17.             arr3(z, 2) = arr1(x, 2)
    
18.           Else
    
19.             arr3(z, 3) = arr2(y)
    
20.           End If
    
21.         Next
    
22.      Else
    
23.        z = z + 1
    
24.        arr3(z, 1) = arr1(x, 1)
    
25.        arr3(z, 2) = arr1(x, 2)
    
26.        arr3(z, 3) = arr1(x, 3)
    
27.      End If
    
28.   Next
    
29.   Set rng = Application.InputBox(prompt:="请选数据择放置区域", Type:=8)
    
30.   rng.Resize(z, 3) = arr3
    
31.   rng.Resize(z, 3) = arr3
    
32.   MsgBox "操作完成！"
    
33. 100:
    
34. End Sub
    

复制代码