VBA列转化行

twhyl

希望大神们，利用VBA帮忙解决下，感谢！

twhyl

问题补充，题目好像有误，但是里面叙述应该清楚！

liulang0808

论坛里很多雷同案例，楼主可以搜一下

twhyl

liulang0808 发表于 2018-6-11 16:33
论坛里很多雷同案例，楼主可以搜一下

哎呀，我初来乍到，搞不清楚呀！不晓得从何下手！搜素都不晓得输入什么名字！麻烦你这位大神帮我写个代码嘛！

twhyl

liulang0808 发表于 2018-6-11 16:33
论坛里很多雷同案例，楼主可以搜一下

版主 帮忙帮我解决下！

liulang0808

1. Sub 按钮1_Click()
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = [a1].CurrentRegion
   
5.     a = 1
   
6.     For j = 2 To UBound(arr)
   
7.         If Len(arr(j, 1)) > 0 Then
   
8.             d(arr(j, 1)) = d(arr(j, 1)) & "##" & arr(j, 2)
   
9.         End If
   
10.     Next j
    
11.     For j = 0 To d.Count - 1
    
12.         arr = Split(d.items()(j), "##")
    
13.         Cells(j + 1, 4).Resize(1, UBound(arr)+1) = arr
    
14.         Cells(j + 1, 4) = d.keys()(j)
    
15.     Next j
    
16.     [d1].CurrentRegion.Borders.LineStyle = xlContinuous
    
17.     Application.ScreenUpdating = True
    
18. End Sub
    

复制代码

liulang0808

附件内容供参考。。。。。。