随机数字

micch

350977106 发表于 2020-2-23 11:31
谢谢老师的讲解！

换个写法，循环次数多一点，看着会清晰一点。

没循环生成一组数据，判断符合就next，不符合就重来

1. Sub test()
   
2.     r = 15 '行数
   
3.     c = 3 '列数
   
4.     ReDim ar(r)
   
5.     For i = 1 To r: ar(i) = i: Next
   
6.     ReDim arr(0 To r, 0 To c)
   
7.     Randomize
   
8.     For i = 1 To c
   
9.         For k = 1 To r
   
10.             n = Int(1 + Rnd * (r - k + 1))
    
11.             arr(k, i) = ar(n)
    
12.             ar(n) = ar(r - k + 1)
    
13.             ar(r - k + 1) = arr(k, i)
    
14.         Next
    
15.         arr(0, i) = " " & Join(ar) & " "
    
16.             For j = 0 To i - 1
    
17.                 For m = 1 To r
    
18.                     If arr(m, i) = arr(m, j) Or InStr(arr(0, j), " " & arr(m, i) & " " & arr(m - 1, i) & " ") > 0 Then
    
19.                         i = i - 1:      m = r:       j = i
    
20.                     End If
    
21.     Next m, j, i
    
22.     For i = 1 To c: arr(0, i) = "第" & i & "组": Next
    
23.     [c:f].Clear
    
24.     [c3].Resize(k, i) = arr
    
25. End Sub

复制代码

一把小刀闯天下

If Timer - tm > 0.01 Then j = j - 1: Exit For

相应行修改了一下能跑出15*10，不是很吃力，估计偶尔会跑不出结果，，，

350977106

liulang0808 发表于 2020-2-23 11:49
涉及死锁的可能，做了次数限制，如果次数太多就重来

谢谢老师！！！

350977106

一把小刀闯天下 发表于 2020-2-23 12:12
If Timer - tm > 0.01 Then j = j - 1: Exit For

相应行修改了一下能跑出15*10，不是很吃力，估计偶尔会 ...

敬佩老师对代码效率的高要求，跑了几次，都成功了，下面是最快的两次截图f:\1.png,2.png

350977106

敬佩老师对代码效率的高要求，跑了几次，都成功了，下面是最快的两次截图

yjh_27

350977106 发表于 2020-2-23 16:37
敬佩老师对代码效率的高要求，跑了几次，都成功了，下面是最快的两次截图

已更新
偶尔得到11列

350977106

使用resize简捷多了。
Function sj(arr)
    Dim i, d, t, m, n
    m = Range("a18")
    n = Range("a19")
    For i = 1 To n
        d = Int(Rnd * n + 1)
        t = arr(i, 1)
        arr(i, 1) = arr(d, 1)
        arr(d, 1) = t
    Next
    sj = arr
End Function
Sub test()
  Dim i, d, t, m, n
  m = Range("a18")
    n = Range("a19")
    ReDim arr(1 To n, 1 To 1)
    For i = 1 To n
        arr(i, 1) = i
    Next
    Cells(1, 1).Resize(n, m) = ""
    For i = 1 To m
X:        arr = sj(arr)
        Cells(1, i).Resize(n) = arr
          For k = 1 To n
   ' If Application.CountIf(Range("a" & k).Resize(1, i), Cells(k, i)) > 1 Then GoTo X
    If Application.CountIf(Cells(k, 1).Resize(1, i), Cells(k, i)) > 1 Then GoTo X
  '  If Application.CountIf(Cells(Cells(k, 1), Cells(k, i)), Cells(k, i)) > 1 Then GoTo X        '******  结果错误
    Next k
   Next i
End Sub

但这两句有什么区别呢？
  If Application.CountIf(Cells(k, 1).Resize(1, i), Cells(k, i)) > 1 Then GoTo X
  '  If Application.CountIf(Cells(Cells(k, 1), Cells(k, i)), Cells(k, i)) > 1 Then GoTo X        '******  结果错误

350977106

yjh_27 发表于 2020-2-23 19:10
已更新
偶尔得到11列

好，赞！！！

yjh_27

350977106 发表于 2020-2-23 19:43
使用resize简捷多了。
Function sj(arr)
    Dim i, d, t, m, n

Cells(k, 1).Resize(1, i)   k行1列至i列的区域

Cells(Cells(k, 1), Cells(k, i))  Cells(k, 1)行Cells(k, i)列的单元格

350977106

range("a1").resize(1,4）是一个整体，而range("a1:d1")是指4个独立的单元格吗？都有什么语句能说明这两者的区别呢？