请教：如何用VBA实现特殊的数据转置问题

sxhmsbl

特殊的数据转置问题.rar (4.6 KB, 下载次数: 8)

2013-1-16 09:01 上传

点击文件名下载附件
特殊的数据转置问题

请教高手：特殊的数据转置问题（见附件）

dsmch

1. Dim arr, brr, i&
   
2. arr = Sheets("Sheet1").Range("a1").CurrentRegion
   
3. ReDim brr(1 To (UBound(arr) - 1) * 2, 1 To UBound(arr, 2))
   
4. For i = 2 To UBound(arr)
   
5.     brr(2 * (i - 1) - 1, 1) = arr(i, 1)
   
6.     brr(2 * (i - 1) - 1, 2) = "本月比"
   
7.     brr(2 * (i - 1) - 1, 3) = arr(i, 2)
   
8.     brr(2 * (i - 1), 2) = "累计比"
   
9.     brr(2 * (i - 1), 3) = arr(i, 3)
   
10. Next
    
11. Sheets("Sheet2").Activate
    
12. Cells.ClearContents
    
13. [a1:c1] = Array("地区", "去年同期增长", "%")
    
14. Range("a2").Resize(UBound(brr), UBound(brr, 2)) = brr
    

复制代码

dsmch

附件…………

sdkj3234

1. Sub cc()
   
2. Dim a%, b%, c%
   
3.   For a = 2 To Range("A65536").End(xlUp).Row
   
4.     Sheets(2).Cells(a * 2 - 2, 1) = Cells(a, 1)
   
5.      Sheets(2).Cells(a * 2 - 2, 2) = "本月比"
   
6.       Sheets(2).Cells(a * 2 - 1, 2) = "累计比"
   
7.        Sheets(2).Cells(a * 2 - 2, 3) = Cells(a, 2)
   
8.      Sheets(2).Cells(a * 2 - 1, 3) = Cells(a, 3)
   
9.     Next a
   
10.   Sheets(2).[a1:c1] = Array("地区", "去年同期增长", "%")
    
11. End Sub
    

复制代码