[已解决]求助：请将G：z列的数据依次 ...

水木

求助：请将G：z列的数据依次转置到F列.rar (9.11 KB, 下载次数: 10)

2015-12-13 17:58 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

dsmch

2015-12-13 21:42

1. Sub Macro1()
   
2. Dim arr, brr, i&, s&, j%, k%
   
3. Sheets("数据").Activate
   
4. arr = ActiveSheet.UsedRange
   
5. ReDim brr(1 To 60000, 1 To 6)
   
6. For i = 1 To UBound(arr)
   
7.     For j = 6 To UBound(arr, 2)
   
8.         If arr(i, j) <> "" Then
   
9.             s = s + 1
   
10.             brr(s, 6) = arr(i, j)
    
11.             For k = 1 To 5
    
12.                 brr(s, k) = arr(i, k)
    
13.             Next
    
14.         End If
    
15.     Next
    
16. Next
    
17. Sheet2.Range("a1").Resize(s, 6) = brr
    
18. End Sub

复制代码

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, i&, s&, j%, k%
   
3. Sheets("数据").Activate
   
4. arr = ActiveSheet.UsedRange
   
5. ReDim brr(1 To 60000, 1 To 6)
   
6. For i = 2 To UBound(arr)
   
7. For j = 6 To UBound(arr, 2)
   
8. If arr(i, j) <> "" Then
   
9. s = s + 1
   
10. brr(s, 6) = arr(i, j)
    
11. For k = 1 To 5
    
12. brr(s, k) = arr(i, k)
    
13. Next
    
14. End If
    
15. Next
    
16. Next
    
17. [a1:f1].Copy Sheet2.[a1]
    
18. Sheet2.Range("a2").Resize(s, 6) = brr
    
19. End Sub

复制代码

水木

dsmch 发表于 2015-12-13 20:56

再求助：请将G：z列的数据依次转置到F列a.rar (13.92 KB, 下载次数: 3)

2015-12-13 21:31 上传

点击文件名下载附件 再求老师，请将A行的标题也转置。

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, i&, s&, j%, k%
   
3. Sheets("数据").Activate
   
4. arr = ActiveSheet.UsedRange
   
5. ReDim brr(1 To 60000, 1 To 6)
   
6. For i = 1 To UBound(arr)
   
7.     For j = 6 To UBound(arr, 2)
   
8.         If arr(i, j) <> "" Then
   
9.             s = s + 1
   
10.             brr(s, 6) = arr(i, j)
    
11.             For k = 1 To 5
    
12.                 brr(s, k) = arr(i, k)
    
13.             Next
    
14.         End If
    
15.     Next
    
16. Next
    
17. Sheet2.Range("a1").Resize(s, 6) = brr
    
18. End Sub

复制代码