|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
想在点击了"试题库"中的随机选题按钮后,在随机选题工作表中的题号列显示1/2/3/4////100这样的题目序号,而不是显示试题库中的题目号,这样试卷工作表中每道题也就有顺号了
--------------------------
- Sub Macro2()
- Dim arr, brr, crr(1 To 100, 1 To 10), i As Integer, J As Integer, d As Object, dic As Object, temp As Integer
- arr = Range("A2:J967")
- Set d = CreateObject("scripting.dictionary")
- Set dic = CreateObject("scripting.dictionary")
- Randomize
- Do
- i = Int((733 * Rnd) + 1)
- d(i) = ""
- Loop Until d.Count = 80
- Do
- i = Int((233 * Rnd) + 734)
- dic(i) = ""
- Loop Until dic.Count = 20
- With Sheets("随机选题")
- .UsedRange.Clear
- Range("A1:J1").Copy .Cells(1, 1)
- .[a2].Resize(80) = WorksheetFunction.Transpose(d.keys)
- .[a82].Resize(20) = WorksheetFunction.Transpose(dic.keys)
- .Range("A2:A101").Sort Key1:=.Range("A2:A101")
- brr = .Range("A2:A101")
- For i = 1 To 100
- temp = brr(i, 1)
- For J = 1 To 10
- crr(i, J) = arr(temp, J)
- Next
- Next
- With .[a2].Resize(100, 10)
- .Borders.LineStyle = xlContinuous
- .Value = crr
- End With
- .Activate
- .[b2].Resize(100) = [row(b1:b100)]'-----------这里加一句即可
- End With
- Application.ScreenUpdating = True
- End Sub
复制代码 |
|