新人求助，就5个金币，大神们帮帮忙，感谢

zjt110110

大神们帮我弄一下随机选题得问题，望各位帮帮忙，感谢！ kaoshi.rar (41.99 KB, 下载次数: 15)

2014-4-20 23:56 上传

点击文件名下载附件
z

那妳雨季

1. Sub 随机选题()
   
2. Dim brr, arr, tx, m, lrow, i, n, r, j, t, k
   
3.     tx = Left([b4], 3) '出题工作簿名称
   
4.     m = Sheets(tx).Cells(Rows.Count, 1).End(xlUp).Value
   
5.     lrow = Cells(Rows.Count, 1).End(xlUp).Value
   
6.     brr = Sheets(tx).Range("b2:b" & m + 1)
   
7.    
   
8.     ReDim a(1 To m) '生成不重复的随机数
   
9.     For i = 1 To m
   
10.         a(i) = i
    
11.     Next
    
12.    
    
13.     n = 1
    
14.     ReDim arr(1 To m, 1 To n)
    
15.    
    
16.     Randomize
    
17.     For j = 1 To n
    
18.         For i = 1 To m
    
19.             r = Int(Rnd * (m - i + 1)) + i
    
20.             t = a(r): a(r) = a(i): a(i) = t: arr(i, j) = t
    
21.         Next
    
22.     Next
    
23.    
    
24.     For j = 1 To lrow '提取题目
    
25.        k = arr(j, 1)
    
26.         arr(j, 1) = brr(k, 1)
    
27.     Next j
    
28.    
    
29.     [b5].Resize(lrow) = arr
    
30.    
    
31. End Sub

复制代码

风林火山

太厉害了

蓝粆

不要重复发帖，帮你的人不在乎那几个金币，给点耐心别人看题目~~

zjt110110

蓝粆 发表于 2014-4-21 08:27
不要重复发帖，帮你的人不在乎那几个金币，给点耐心别人看题目~~

好的。谢谢！

zjt110110

那妳雨季 发表于 2014-4-21 04:50

谢谢您的帮忙！
然后问一下fori=1 To m a（i）=i这里提示我缺少语句结束，错误点在To。这里该怎么弄？

zjt110110

那妳雨季 发表于 2014-4-21 04:50

运行时提示错误，下标越界  m=sheets(tx).cells(rows.count,1).end(xlup).value这句

zjt110110

那妳雨季 发表于 2014-4-21 04:50

希望您帮我处理一下，谢谢

那妳雨季

zjt110110 发表于 2014-4-21 09:25
运行时提示错误，下标越界  m=sheets(tx).cells(rows.count,1).end(xlup).value这句

把工作表切换到。出题的工作表。。在运行代码。

su45

昨晚看到了，只是太晚了，今天看已有结果了！