每三个单元格进行排序，求代码

toiletstone

详见下图说明及附件，拜托各位老师了



新建 Microsoft Office Excel 2007 工作表.zip (6.92 KB, 下载次数: 9)

2015-5-10 23:10 上传

点击文件名下载附件

yjh_27

参见附件。

bluexuemei

1. Sub test()
   
2. '需要安装ACTIVERUBY ，下载地址 http://www.artonx.org/data/asr/Ruby-2.1.1.msi
   
3. Set ojs = CreateObject("scriptcontrol"): ojs.Language = "rubyscript"
   
4. ojs.eval ("def aa(aa);$aa=aa;end")
   
5. y = ojs.Run("aa", Range("f3:g" & [g3].End(4).Row).Value)
   
6. y = ojs.eval("$aa.each_slice(3).flat_map{|arr|arr.sort_by{|x|-x[1]}}")
   
7. [j3].Resize(UBound(y) + 1, UBound(y, 2) + 1) = y
   
8. 'Stop
   
9. End Sub

复制代码

Vicel

1. Sub test()
   
2.     Dim ar, a, b, i&, j&, k&
   
3.     ar = Range("F3:G" & [F65536].End(xlUp).Row)
   
4.     For i = 1 To UBound(ar) Step 3
   
5.         For j = i To i + 1
   
6.             For k = j + 1 To i + 2
   
7.                 If ar(k, 2) > ar(j, 2) Then
   
8.                     a = ar(j, 1): b = ar(j, 2)
   
9.                     ar(j, 1) = ar(k, 1): ar(j, 2) = ar(k, 2)
   
10.                     ar(k, 1) = a: ar(k, 2) = b
    
11.                 End If
    
12.             Next k
    
13.         Next j
    
14.     Next i
    
15.     Range("F3:G" & [F65536].End(xlUp).Row) = ar
    
16. End Sub
    

复制代码

test.zip (7.95 KB, 下载次数: 5)

2015-5-10 23:47 上传

点击文件名下载附件

chxw68

1. Sub test()
   
2.   Dim r%, i%, p%, k%
   
3.   Dim arr, brr
   
4.   With Worksheets("sheet1")
   
5.     arr = .Range("f3:g8")
   
6.     ReDim brr(1 To UBound(arr), 1 To 1)
   
7.     For i = 1 To UBound(arr)
   
8.       brr(i, 1) = (UBound(arr) - Int((i - 1) / 3 + 1)) * 1000 + arr(i, 2)
   
9.     Next
   
10.     For i = 1 To UBound(brr) - 1
    
11.       p = i
    
12.       For j = i + 1 To UBound(brr)
    
13.         If brr(p, 1) < brr(j, 1) Then
    
14.           p = j
    
15.         End If
    
16.       Next
    
17.       If p <> i Then
    
18.         temp = brr(i, 1)
    
19.         brr(i, 1) = brr(p, 1)
    
20.         brr(p, 1) = temp
    
21.         For k = 1 To UBound(arr, 2)
    
22.           temp = arr(i, k)
    
23.           arr(i, k) = arr(p, k)
    
24.           arr(p, k) = temp
    
25.         Next
    
26.       End If
    
27.     Next
    
28.     .Range("j3").Resize(UBound(arr), UBound(arr, 2)) = arr
    
29.   End With
    
30. End Sub
    

复制代码

chxw68

也来凑个热闹。