[已解决]请帮我调试一下这段代码好不好哦

tjc5471

亲，请帮我调试一下这段代码好不好哦？

最佳答案

月排行榜 / 总排行榜

grf1973

2015-11-4 13:41

请看附件。

跳转到最佳答案楼层

金樽空对月

兄弟，猜了半天，没看懂你到底要怎么弄呀！[em06]

grf1973

1. Sub test()
   
2.     arr = Range("a1:y15")
   
3.     Dim crr(1 To 24)
   
4.     Dim xrr(1 To 24)
   
5.     For i = 4 To 12 Step 2
   
6.         brr = Cells(i, 1).Resize(1, 24): n = 0        '2、4、6、8...各行入数组
   
7.         For j = 1 To UBound(brr, 2)
   
8.             If Val(brr(1, j)) > 0 And Val(arr(15, j)) > 0 Then         '本行大于0，15行对应位置大于0，进入数组crr待排序
   
9.                 n = n + 1
   
10.                 crr(n) = arr(15, j)
    
11.             End If
    
12.         Next
    
13.         If n = 1 Then          '如果crr一个数，直接取用，不排序，直接进结果数组
    
14.             nn = nn + 1: xrr(nn) = crr(n)
    
15.         Else           '否则对crr排序
    
16.             For k = 1 To n - 1
    
17.                 For kk = k + 1 To n
    
18.                     If crr(k) < crr(kk) Then tmp = crr(k): crr(k) = crr(kk): crr(kk) = tmp
    
19.                 Next
    
20.             Next
    
21.             For k = 1 To n     '排过序后进结果数组
    
22.                 If crr(k) > 0 Then nn = nn + 1: xrr(nn) = crr(k)
    
23.             Next
    
24.         End If
    
25.     Next
    
26.     [a29].Resize(1, nn) = xrr   '显示结果数组
    
27. End Sub
    

复制代码

grf1973

请看附件。

tjc5471

grf1973朋友真厉害，就是这回事了，真是太感谢了。