[已解决]如何更快的做

mmc998

Book零行零列.rar (44.79 KB, 下载次数: 14)

2014-2-20 20:24 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

dsmch

2014-2-20 21:47

1. Sub Macro1()
   
2. Dim arr, brr, i&
   
3. arr = Range("a3:c" & Range("c65536").End(xlUp).Row)
   
4. ReDim brr(1 To UBound(arr), 1 To 6)
   
5. For i = 1 To UBound(arr) - 2 Step 4
   
6.     brr(i, 1) = arr(i, 1) & arr(i + 1, 2) & arr(i + 2, 3)
   
7.     brr(i, 2) = arr(i + 2, 1) & arr(i + 1, 2) & arr(i, 3)
   
8.     brr(i, 3) = arr(i + 1, 1) & arr(i, 2) & arr(i + 2, 3)
   
9.     brr(i, 4) = arr(i, 2) & arr(i + 1, 3) & arr(i, 1)
   
10.     brr(i, 5) = arr(i, 1) & arr(i + 1, 3) & arr(i + 2, 2)
    
11.     brr(i, 6) = arr(i, 3) & arr(i + 2, 2) & arr(i + 1, 1)
    
12. Next
    
13. [d:i].NumberFormatLocal = "@"
    
14. Range("d3").Resize(UBound(brr), UBound(brr, 2)) = brr
    
15. End Sub
    

复制代码

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, i&
   
3. arr = Range("a3:c" & Range("c65536").End(xlUp).Row)
   
4. ReDim brr(1 To UBound(arr), 1 To 6)
   
5. For i = 1 To UBound(arr) - 2 Step 4
   
6.     brr(i, 1) = arr(i, 1) & arr(i + 1, 2) & arr(i + 2, 3)
   
7.     brr(i, 2) = arr(i + 2, 1) & arr(i + 1, 2) & arr(i, 3)
   
8.     brr(i, 3) = arr(i + 1, 1) & arr(i, 2) & arr(i + 2, 3)
   
9.     brr(i, 4) = arr(i, 2) & arr(i + 1, 3) & arr(i, 1)
   
10.     brr(i, 5) = arr(i, 1) & arr(i + 1, 3) & arr(i + 2, 2)
    
11.     brr(i, 6) = arr(i, 3) & arr(i + 2, 2) & arr(i + 1, 1)
    
12. Next
    
13. [d:i].NumberFormatLocal = "@"
    
14. Range("d3").Resize(UBound(brr), UBound(brr, 2)) = brr
    
15. End Sub
    

复制代码

dsmch

………………

mmc998

dsmch 发表于 2014-2-20 21:53
………………

可以

韦云1968

学习