用VBA达成行列转换

鹧鸪仔

各位大侠：

请教一个问题，如何用VBA达成行列转换的功能呀，效果要和SQL Server里面用pivot的一样，可惜电脑里面木有SQL server，只能用EXCEL来完成。
详细的可以参考附件，就是要将数据源改为更新后的，万分感谢！！！

kuaile5935

sub test()
arr=range("A1:A10")
range("B1:k1")=application.transpose(arr)
end sub

鹧鸪仔

谢谢！！想确认下，因为之前看到好像说transpose的可用的数据量比较少，如果我有1千行数据，这个也可以用吗？谢谢！

huang1314wei

1. Sub texct()
   
2.     Dim arr, brr(), i%, j%, n%, m%
   
3.     Sheet2.Rows(2 & ":" & Rows.Count).ClearContents
   
4.     arr = Range("A1").CurrentRegion
   
5.     ReDim brr(1 To 1000, 1 To 7)
   
6.     For i = 2 To UBound(arr)
   
7.         For j = 6 To UBound(arr, 2)
   
8.             n = n + 1
   
9.             For m = 1 To 5
   
10.                 brr(n, m) = arr(i, m)
    
11.             Next
    
12.             brr(n, 6) = arr(1, j)
    
13.             brr(n, 7) = arr(i, j)
    
14.         Next
    
15.     Next
    
16.     Sheet2.Range("A2").Resize(n, 7) = brr
    
17. End Sub

复制代码

huang1314wei

附件如下：

test.rar (18.31 KB, 下载次数: 233)

2015-8-4 15:09 上传

点击文件名下载附件

wzb5566

1. Sub test()
   
2. With Sheets("数据源")
   
3.     arr = .[A1].CurrentRegion
   
4.     ReDim brr(1 To (UBound(arr, 1) - 1) * (UBound(arr, 2) - 5), 1 To 7)
   
5.     For j = 6 To UBound(arr, 2)
   
6.         For i = 2 To UBound(arr, 1)
   
7.             brr((i - 2) * (UBound(arr, 2) - 5) + j - 5, 7) = arr(i, j)
   
8.             brr((i - 2) * (UBound(arr, 2) - 5) + j - 5, 6) = arr(1, j)
   
9.             For k = 1 To 5
   
10.                 brr((i - 2) * (UBound(arr, 2) - 5) + j - 5, k) = arr(i, k)
    
11.             Next
    
12.         Next
    
13.     Next
    
14.     Sheets("更新后").[A2].Resize(UBound(brr, 1), UBound(brr, 2)) = brr
    
15. End With
    
16. End Sub

复制代码

鹧鸪仔

huang1314wei 发表于 2015-8-4 15:09
附件如下：

能帮我一个忙吗。。。。非常感谢你的回答，但是由于附件内容有公司的一些信息，比较敏感，所以可以帮忙在你回复的这里将附件删除吗？因为我没有权限和版主沟通：（ 拜托拜托您啦！！！！

LMY123

行列转换，三维转二维，5列固定

ruitree

翻出来学习