数据转换

szqhb

数据转换求助.zip (12.24 KB, 下载次数: 5)

2023-4-12 16:19 上传

点击文件名下载附件

数据格式转换求助，要求见图示

相当于https://club.excelhome.net/thread-1518546-2-1.html链接的17、18楼的逆向操作

chxw68

1. Sub test()
   
2.     Dim r%, i%
   
3.     Dim arr, brr
   
4.     With Worksheets("sheet1")
   
5.         r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
6.         arr = .Range("a2:d" & r)
   
7.         ReDim brr(1 To 1000, 1 To 3)
   
8.         m = 0
   
9.         For i = 2 To UBound(arr)
   
10.             For j = 2 To UBound(arr, 2)
    
11.                 If Len(arr(i, j)) <> 0 Then
    
12.                     xm = Split(arr(i, j), "、")
    
13.                     For k = 0 To UBound(xm)
    
14.                         m = m + 1
    
15.                         brr(m, 1) = arr(i, 1)
    
16.                         brr(m, 2) = xm(k)
    
17.                         brr(m, 3) = arr(1, j)
    
18.                     Next
    
19.                 End If
    
20.             Next
    
21.         Next
    
22.         With .Range("h3").Resize(m, UBound(brr, 2))
    
23.             .Value = brr
    
24.             .Borders.LineStyle = xlContinuous
    
25.             .HorizontalAlignment = xlCenter
    
26.             .VerticalAlignment = xlCenter
    
27.         End With
    
28.     End With
    
29. End Sub
    

复制代码

chxw68

详见附件。

szqhb

chxw68 发表于 2023-4-12 16:30
详见附件。

万分感谢。经常打扰你！