[已解决]如何用代码自动组合数据？

dfshm

附件 数据组合附件.rar (58.22 KB, 下载次数: 22)

2013-6-7 21:44 上传

点击文件名下载附件
先谢谢各位师傅。

最佳答案

月排行榜 / 总排行榜

csmctjg

2013-6-8 08:44

1. Sub aa()
   
2.     Dim i%, j%, k&, x%, arr, brr(1 To 100000, 1 To 5)
   
3.     arr = Range("A1:E" & Range("A" & Rows.Count).End(3).Row)
   
4.     For i = 1 To UBound(arr) - 4
   
5.         For j = i + 1 To i + 4
   
6.             k = k + 3
   
7.             For x = 1 To 5
   
8.                 brr(k - 2, x) = arr(i, x)
   
9.                 brr(k - 1, x) = arr(j, x)
   
10.             Next
    
11.         Next
    
12.     Next
    
13.     [A1].Resize(UBound(arr), 5).ClearContents
    
14.     [A1].Resize(k, 5) = brr
    
15. End Sub
    
16. 
    
17. 若结尾不足4对组合也须组合的话用下面程序：
    
18. 
    
19. Sub aa()
    
20.     Dim i%, j%, k&, x%, arr, brr(1 To 100000, 1 To 5)
    
21.     arr = Range("A1:E" & Range("A" & Rows.Count).End(3).Row)
    
22.     For i = 1 To UBound(arr) - 1
    
23.         For j = i + 1 To i + IIf(UBound(arr) - i < 4, UBound(arr) - i, 4)
    
24.             k = k + 3
    
25.             For x = 1 To 5
    
26.                 brr(k - 2, x) = arr(i, x)
    
27.                 brr(k - 1, x) = arr(j, x)
    
28.             Next
    
29.         Next
    
30.     Next
    
31.     [A1].Resize(UBound(arr), 5).ClearContents
    
32.     [A1].Resize(k, 5) = brr
    
33. End Sub
    
34. 
    

复制代码

跳转到最佳答案楼层

csmctjg

1. Sub aa()
   
2.     Dim i%, j%, k&, x%, arr, brr(1 To 100000, 1 To 5)
   
3.     arr = Range("A1:E" & Range("A" & Rows.Count).End(3).Row)
   
4.     For i = 1 To UBound(arr) - 4
   
5.         For j = i + 1 To i + 4
   
6.             k = k + 3
   
7.             For x = 1 To 5
   
8.                 brr(k - 2, x) = arr(i, x)
   
9.                 brr(k - 1, x) = arr(j, x)
   
10.             Next
    
11.         Next
    
12.     Next
    
13.     [A1].Resize(UBound(arr), 5).ClearContents
    
14.     [A1].Resize(k, 5) = brr
    
15. End Sub
    
16. 
    
17. 若结尾不足4对组合也须组合的话用下面程序：
    
18. 
    
19. Sub aa()
    
20.     Dim i%, j%, k&, x%, arr, brr(1 To 100000, 1 To 5)
    
21.     arr = Range("A1:E" & Range("A" & Rows.Count).End(3).Row)
    
22.     For i = 1 To UBound(arr) - 1
    
23.         For j = i + 1 To i + IIf(UBound(arr) - i < 4, UBound(arr) - i, 4)
    
24.             k = k + 3
    
25.             For x = 1 To 5
    
26.                 brr(k - 2, x) = arr(i, x)
    
27.                 brr(k - 1, x) = arr(j, x)
    
28.             Next
    
29.         Next
    
30.     Next
    
31.     [A1].Resize(UBound(arr), 5).ClearContents
    
32.     [A1].Resize(k, 5) = brr
    
33. End Sub
    
34. 
    

复制代码