[已解决]第n大差

mmc998

Book第n大差.zip (177.19 KB, 下载次数: 5)

2015-1-2 08:03 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

qh8600

2015-1-2 09:01

Book第n大差.rar (84.64 KB, 下载次数: 4)

2015-1-2 09:01 上传

点击文件名下载附件
楼主试试，点按钮哈

跳转到最佳答案楼层

qh8600

1. Sub demo()
   
2.     Dim ar, re(), xx, i, j, x, y
   
3.     ar = Range("b3:g" & Cells(Rows.Count, 2).End(3).Row)
   
4.     ReDim re(1 To UBound(ar), 1 To UBound(ar, 2) - 1)
   
5.     For i = 1 To UBound(ar)
   
6.         For j = 1 To UBound(ar, 2) - 1
   
7.             re(i, j) = Abs(ar(i, j) - ar(i, j + 1))
   
8.         Next
   
9.         For x = 1 To UBound(re, 2)
   
10.             For y = x + 1 To UBound(re, 2)
    
11.                 If re(i, x) < re(i, y) Then
    
12.                     xx = re(i, y)
    
13.                     re(i, y) = re(i, x)
    
14.                     re(i, x) = xx
    
15.                 End If
    
16.             Next
    
17.         Next
    
18. Next
    
19. Range("k3").Resize(UBound(re), UBound(re, 2)) = re
    
20. End Sub

复制代码

附件楼下

qh8600

Book第n大差.rar (84.64 KB, 下载次数: 4)

2015-1-2 09:01 上传

点击文件名下载附件
楼主试试，点按钮哈

蓝桥玄霜

1. Sub lqxs()
   
2. Dim Arr, i&, Brr(4), j&, Crr
   
3. Sheet1.Activate
   
4. [k3:o5000].ClearContents
   
5. Arr = [a1].CurrentRegion
   
6. ReDim Crr(1 To UBound(Arr) - 2, 1 To 5)
   
7. For i = 3 To UBound(Arr)
   
8.     For j = 3 To UBound(Arr, 2)
   
9.         Brr(j - 3) = Arr(i, j) - Arr(i, j - 1)
   
10.     Next
    
11.     For j = 0 To UBound(Brr)
    
12.         Crr(i - 2, j + 1) = Application.Large(Brr, j + 1)
    
13.     Next
    
14. Next
    
15. [k3].Resize(UBound(Crr), 5) = Crr
    
16. MsgBox "OK"
    
17. End Sub
    

复制代码

蓝桥玄霜

请见附件。

tgydslr

拜读，欣赏

mmc998

蓝桥玄霜 发表于 2015-1-2 09:10
请见附件。

谢谢