[已解决]矩形区域中任选随机不重复值并按指定列数输出结果】

张雄友

溢出问题，溢出堆栈空间，不知问题在哪里，已定义LONG 型变量。

最佳答案

月排行榜 / 总排行榜

香川群子

2014-3-5 23:18

规则如下：
① 从A1开始的多列区域为源数据，第1行为列标题，允许各列数据个数(行数)不等 （即部分含有空白单元格）
② 需要抽取个数n 由对话框输入数值后(自动Int取整)，但不得大于元素总个数m，也不能<1
③ 输出结果仍按同样列数……但行数会根据n大小自动决定
④ 输出结果为源数据区域间隔1列开始，第1行留空


下面是从A1开始多行多列的矩形区域中任意取n个随机不重复值的代码：

1. 
   
2. Sub RctDataRnd()
   
3.     Dim rw&, cl&, i&, j&, ii&, jj&, m&, n&, r&, t
   
4.    
   
5.     arr = [a1].CurrentRegion.Offset(1)
   
6.     m = Application.CountA([a1].CurrentRegion.Offset(1))
   
7.     rw = UBound(arr) - 1: cl = UBound(arr, 2)
   
8.     [a1].Offset(1, cl + 1).CurrentRegion = ""
   
9.     n = Int(Val(InputBox("How many ?" & vbCr & " [1 to " & m & "]", "Get Rand", 238)))
   
10.     If n <= 0 Or n > m Then MsgBox "HeadCounts is not correct.": Exit Sub
    
11.    
    
12.     Randomize
    
13.     For i = 1 To rw
    
14.         For j = 1 To cl
    
15.             Do
    
16.                 r = Int(Rnd() * ((rw - i + 1) * cl - j + 1)) + (i - 1) * cl + j - 1
    
17.                 ii = Int(r / cl) + 1: jj = r Mod cl + 1
    
18.                 t = arr(ii, jj)
    
19.                 If t <> "" Then
    
20.                     arr(ii, jj) = arr(i, j): arr(i, j) = t
    
21.                     n = n - 1: If n = 0 Then Exit For Else Exit Do
    
22.                 End If
    
23.             Loop
    
24.         Next
    
25.         If n = 0 Then
    
26.             For j = j + 1 To cl
    
27.                 arr(i, j) = ""
    
28.             Next
    
29.             Exit For
    
30.         End If
    
31.     Next
    
32.     [a1].Offset(1, cl + 1).Resize(i, cl) = arr
    
33. End Sub
    

复制代码

附件有更新，加了元素总数m的计算。

跳转到最佳答案楼层

fffox

运行没有出错

张雄友

请看。

香川群子

【张雄友】你这个代码是你自己写的吧，实在是太差劲了！

你的代码没有意思，一句也不能用。应该重新写过。


……
我猜测你是要在A列中随机取不重复的值，个数可以设定（本例为=9999）

…………
另外，错误的原因在于你的随机取值过程【非常不必要地】使用了【递归方法】，
且你的递归方法在随机产生重复时【只有进、没有来得及出】，所以当重复次数过多时必然导致【堆栈溢出】的错误。

张雄友

香川群子 发表于 2014-3-5 20:49
【张雄友】你这个代码是你自己写的吧，实在是太差劲了！

你的代码没有意思，一句也不能用。应该重新写过 ...

有请阁下指导工作。

香川群子

简单几句代码就足够了！

Sub GetRnd()
    Dim arr, i&, m&, n&, r&, t
    [b2:b65536] = ""
    m = [a1].End(4).Row - 1: arr = [a2].Resize(m)
    n = Val(InputBox("How many ?", "Get Rand", 238))
    If n <= 0 Or n > m Then MsgBox "HeadCounts is not correct.": Exit Sub
   
    Randomize
    For i = 1 To n
        r = Int((m - i + 1) * Rnd) + i
        t = arr(r, 1): arr(r, 1) = arr(i, 1): arr(i, 1) = t
    Next
    [b2].Resize(n) = arr
End Sub

核心代码就蓝色几句……【经典数组洗牌算法】即可得到随机不重复乱序结果。

香川群子

随机不重复部分使用【经典数组洗牌算法】非常简洁：

  For i = 1 To n
        r = Int((m - i + 1) * Rnd) + i
        t = arr(r, 1): arr(r, 1) = arr(i, 1): arr(i, 1) = t
    Next

   代码算法解释：

  For i = 1 To n  '循环遍历抽取n个不重复值

        r = Int((m - i + 1) * Rnd) + i  '从剩余m-i+1个数中获取随机数。由于此范围是变动的，可保证不重复。

        t = arr(r, 1)               '随机抽到的r位置值存入临时变量t
        arr(r, 1) = arr(i, 1)     '当前第 i 个值写入r位置(本次随机值)
                                         ' →  这个过程不仅避免遗漏、和重复，还能顺便打乱顺序，效率非常之高。
        arr(i, 1) = t                '临时变量t中存放的r位置随机值，写入当前 i位置 完成交换。

    Next


详细解释抽取过程中剩余数和位置区间关系：
  
标题： i 值   剩余个数  随机抽取范围  已排除区间
计算：    i          m-i+1        [i ,   m]             [0, i-1]
             1           m             [1,  m]              [0, 0]
             2          m - 1         [2,  m]              [0, 1]
             3          m - 2         [3,  m]              [0, 2]
             4          m - 3         [4,  m]              [0, 3]
            …………
            m-2        3           [m-2, m]              [0, m-3]
            m-1        2           [m-1, m]              [0, m-2]
             m          1            [ m , m]              [0,  m-1]


这样就明白了吧！

张雄友

香川群子 发表于 2014-3-5 21:19
简单几句代码就足够了！

Sub GetRnd()

Sub GetRnd()
    Dim arr, i&, m&, n&, r&, t
    [C2:C65536] = ""
    m = [a1].End(4).Row - 1: arr = [a2].Resize(m) '假设源区域有2列,A2:B10000,[a2].Resize(m)这句要怎么修改?
    n = Val(InputBox("How many ?", "Get Rand", 238))
    If n <= 0 Or n > m Then MsgBox "HeadCounts is not correct.": Exit Sub

    Randomize
    For i = 1 To n
        r = Int((m - i + 1) * Rnd) + i
        t = arr(r, 1): arr(r, 1) = arr(i, 1): arr(i, 1) = t
    Next
    [C2].Resize(n) = arr
End Sub

香川群子

如果源数据有两列……或者更多列而成为一个区域，那你的抽取规则如何？

是把它们都当做同一类型，任意抽取，只要保证随机不重复就可以了吗？

张雄友

香川群子 发表于 2014-3-5 22:21
如果源数据有两列……或者更多列而成为一个区域，那你的抽取规则如何？

是把它们都当做同一类型，任意抽 ...

如果源数据有两列……或者更多列而成为一个区域，抽取规则不变。

是把它们都当做同一类型，任意抽取，只要保证随机不重复就可以了。