[已解决]将横排数据变成竖排形式

wenwen000424

将aaa.xls的sheets(10)表中数据改成竖排形式，请帮助，谢谢！ 求助.rar (177.17 KB, 下载次数: 31)

2013-2-27 07:46 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-2-27 16:50

(, 下载次数: 9)

上传

点击文件名下载附件
代码里有注释，窗体对于列数还有限制。

跳转到最佳答案楼层

hwc2ycy

转换函数用了没？

hwc2ycy

相同货号规格的不合并？
下面C3127225还是记录。

wenwen000424

hwc2ycy 发表于 2013-2-27 08:34
相同货号规格的不合并？
下面C3127225还是记录。

谢谢关注，现只提取部分数据，变成如我手工做的结果。

hwc2ycy

1. Sub 转换()
   
2.     Dim arr, i&, j&
   
3.     With Worksheets(1)
   
4.         arr = .Range("a3", .Cells(Rows.Count, "l").End(xlUp))
   
5. 
   
6.         Dim dic As Object
   
7.         Dim Key$
   
8.         Set dic = CreateObject("scripting.dictionary")
   
9.         For i = LBound(arr) + 1 To UBound(arr)
   
10.             For j = 7 To 11
    
11.                 Key = arr(i, 4) & arr(1, j)
    
12.                 dic(Key) = dic(Key) + arr(i, j)
    
13.             Next
    
14.         Next
    
15. 
    
16.         If dic.Count > 0 Then
    
17.             Application.ScreenUpdating = False
    
18.             .Range("n3").Resize(, 2) = Array("款式编号", "库存数量")
    
19.             .Range("n4").Resize(dic.Count) = Application.Transpose(dic.keys)
    
20.             .Range("o4").Resize(dic.Count) = Application.Transpose(dic.items)
    
21.             Application.ScreenUpdating = True
    
22.             MsgBox "合并完成", vbInformation + vbOKOnly
    
23.         End If
    
24.     End With
    
25. End Sub

复制代码

hwc2ycy

提取出的结果你筛选一下就成了。

wenwen000424

hwc2ycy 发表于 2013-2-27 08:54
提取出的结果你筛选一下就成了。

谢谢，我想从aaa.xls的sheets(10)中读取数据，请问代码如何改？

hwc2ycy

把代码丢到aaa.xls里面。

hwc2ycy

另外，注意标题行是在第几行。

hwc2ycy

我写的时候就是在AAA.XLS里操作的。你把代码存到AAA.XLS，就会在N3的位置显示合并数据的。