随机数字

micch

不知道有没有BUG

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.             Do
    
11.                 n = Int(1 + Rnd * (r - k + 1))
    
12.                 x = True
    
13.                 For j = 0 To i - 1
    
14.                     w = InStr(arr(0, j) & ar(n) & " ", " " & ar(n) & " ") + 3
    
15.                     If arr(k, j) = ar(n) Or Val(Mid(arr(0, j) & 999999, w)) = arr(k - 1, i) Then
    
16.                         x = False
    
17.                         Exit For
    
18.                     End If
    
19.                 Next
    
20.                 If x = True Then Exit Do
    
21.             Loop
    
22.             arr(k, i) = ar(n)
    
23.             ar(n) = ar(r - k + 1)
    
24.             ar(r - k + 1) = arr(k, i)
    
25.         Next
    
26.         arr(0, i) = " " & Join(ar) & " "
    
27.     Next
    
28.     For i = 1 To c: arr(0, i) = "": Next
    
29.     [c:f].Clear
    
30.     [c3].Resize(k, i) = arr
    
31. End Sub

复制代码

excel海

350977106 发表于 2020-2-22 19:41
加入行判断语句，用单重复生成随机数，能达到要求，用大循环，就出错。是哪儿了出错了呢。

这样应该可以

1. Sub test()
   
2.   Dim i, d, t, brr, j
   
3.     ReDim arr(1 To 15, 1 To 1)
   
4.     For i = 1 To 15
   
5.         arr(i, 1) = i
   
6.     Next
   
7.     For i = 1 To 4
   
8.         arr = sj(arr)
   
9.         Cells(1, i).Resize(15) = arr
   
10.     Next
    
11.     brr = Sheet1.UsedRange
    
12.     For i = 1 To 15
    
13.         For j = 1 To 4
    
14.             If Application.CountIf(Sheet1.Cells(i, 1).Resize(1, 4), Sheet1.Cells(i, j)) > 1 Then
    
15.                 Debug.Print i
    
16.                 test
    
17.             End If
    
18.         Next
    
19.     Next
    
20. End Sub

复制代码

WYS67

yjh_27 发表于 2020-2-22 14:48
参见附件。

神操作--送花时网页卡死了，等恢复后才看到手里的7朵花变成了0；再一看，一下子送出了9朵--只有版主这样的土豪，才会有如此的败家待遇啊！

350977106

excel海 发表于 2020-2-22 21:55
这样应该可以

好，谢谢！解决了行内数字有重复的问题

350977106

micch 发表于 2020-2-22 20:17
不知道有没有BUG

行，很好。我是个vba小白，看见用数组和字典编辑的，就头晕。
w = InStr(arr(0, j) & ar(n) & " ", " " & ar(n) & " ") + 3
                    If arr(k, j) = ar(n) Or Val(Mid(arr(0, j) & 999999, w)) = arr(k - 1, i) Then
这个W指什么。下面判断语句出现的9999999这么大数，表示什么

micch

350977106 发表于 2020-2-23 11:14
行，很好。我是个vba小白，看见用数组和字典编辑的，就头晕。
w = InStr(arr(0, j) & ar(n) & " ", " "  ...

99999999那是随便写的，W是取得数字在生成的一列中的位置，要取这个位置的上一个数字看是否重复，如果数字在最后一个，那么后面就没数字了，所以加一个9999999这样就取到999，避免if判断出错

350977106

liulang0808 发表于 2020-2-21 19:15

老师，你好！
语句中的w和w>1000指什么，我是小白，望不吝赐教，谢谢！！！

350977106

micch 发表于 2020-2-23 11:19
99999999那是随便写的，W是取得数字在生成的一列中的位置，要取这个位置的上一个数字看是否重复，如果数 ...

谢谢老师的讲解！

liulang0808

350977106 发表于 2020-2-23 11:23
老师，你好！
语句中的w和w>1000指什么，我是小白，望不吝赐教，谢谢！！！

涉及死锁的可能，做了次数限制，如果次数太多就重来

一把小刀闯天下

'跑到15*8已经很吃力了，，，

Option Explicit

Const X = 15, Y = 3 '15*3

Sub test()
  Dim i, j, k, n, t, tm
  ReDim arr(1 To X), brr(1 To X, 1 To Y), dic(X)
  For i = 1 To X
    arr(i) = i
  Next
  For j = 1 To Y
    Set dic(j) = CreateObject("scripting.dictionary")
    If j = 1 Then
      For i = 1 To X
        n = Int(Rnd * (X - i + 1)) + i
        t = arr(i): arr(i) = arr(n): arr(n) = t: brr(i, j) = arr(i)
        If i > 1 Then dic(j)(arr(i - 1) & "-" & arr(i)) = 1
      Next
    Else
      tm = Timer
      For i = 1 To X
        n = Int(Rnd * (X - i + 1)) + i
        t = arr(i): arr(i) = arr(n): arr(n) = t: brr(i, j) = arr(i)
        For k = 1 To j - 1
          If brr(i, k) = brr(i, j) Then i = i - 1: Exit For
          If i > 1 Then
            If dic(k).exists(arr(i - 1) & "-" & arr(i)) Then i = i - 1: Exit For
          End If
        Next
        If k = j And i > 1 Then dic(j)(arr(i - 1) & "-" & arr(i)) = 1
        If Timer - tm > 0.01 Then j = 1: Exit For
        DoEvents
      Next
    End If
  Next
  [a1].Resize(X, Y) = brr
End Sub