|
为了确保五个连续数在同一列中多次出现时,不产生相互重叠,
利用了我自己编写的自动生成均匀随机序号的代码,稍微复杂了一点。- Sub RndNumCol()
- tms = Timer
-
- Dim Mx&, Mn&, Rs&, Col%, Fcnt%
- Dim i&, j&, k&, n%, f%, rw&, cl%, r&, c%, c1%, c2%
-
- Mx = [最大数]: Mn = [最小数]: If Mx <= Mn Then MsgBox "最大数必须大于最小数.": Exit Sub
- Rs = [行数]: If Rs < 1 Or Rs > 65536 Then MsgBox "请准确设置行数(1-65536)": Exit Sub
- If Rs Mod (Mx - Mn + 1) Then MsgBox "生成行数必须是选字数字的倍数": Exit Sub
- Col = [列数]: If Col < 1 Or Col > 256 Then MsgBox "请准确设置列数": Exit Sub
-
- ReDim Arr(1 To Rs, 0 To Col)
- ' Bs = Rs / (Mx - Mn + 1) '倍数=取数个数的倍数
- For j = 1 To Rs / (Mx - Mn + 1)
- For i = Mn To Mx
- k = k + 1
- Arr(k, Col) = i
- Next
- Next
-
- lxs = [指定连续数]: c1 = [下限次数]: c2 = [上限次数]
- n = UBound(lxs)
- Fcnt = [文件数]
-
- Randomize
- Application.DisplayAlerts = False
- Application.ScreenUpdating = False
-
- For f = 1 To Fcnt
- Workbooks.Add 1
- For cl = 0 To Col - 1
- For rw = Rs To 1 Step -1
- r = Int(Rnd * rw) + 1
- Arr(rw, cl) = Arr(r, Col) 't=r
- Arr(r, cl) = Arr(rw, Col) 'r=rw
- Arr(rw, Col) = Arr(rw, cl) 'rw=t
- Arr(r, Col) = Arr(r, cl) 'r=rw
- Next
- c = Int(Rnd * (c2 - c1 + 1) + c1)
- crr = GetRndAvg(1, Rs - n + 1, c, n)
- For c = 1 To c
- r = crr(c) - 1
- For k = 1 To n
- Arr(r + k, cl) = lxs(k, 1)
- Next
- Next
- Next
- ActiveSheet.Cells(1, 1).Resize(Rs, Col) = Arr
- ActiveWorkbook.SaveAs ThisWorkbook.Path & "" & f '& ".xls"
- ActiveWorkbook.Close
- Next
- Application.ScreenUpdating = True
- MsgBox Format(Timer - tms, "0.000s")
- End Sub
复制代码 另外,写入文件是否可以用txt方法,速度会更快。
|
|