选定矩形范围后，从1开始自动随机填数。

香川群子

Sub AddRnd()
    Dim S As New Collection
    Randomize
   
    R = Selection.Rows.Count
    C = Selection.Columns.Count
    ReDim arr(1 To R, 1 To C)
   
    For i = 1 To R * C
        S.Add i
    Next i
   
    For i = 1 To R
        For j = 1 To C
            K = Int(Rnd() * S.Count + 1)
            arr(i, j) = S(K)
            S.Remove (K)
        Next
    Next
    Selection = arr
   
End Sub

jie-jie

Sub aa()
Dim d, arr, c, i%
Set d = CreateObject("scripting.dictionary")
Do
    d(Int(Rnd * Selection.Count + 1)) = ""
Loop Until d.Count = Selection.Count
arr = d.Keys
For Each c In Selection
    c.Value = arr(i)
    i = i + 1
Next
Set d = Nothing
End Sub

jie-jie

再改一下：
Sub aa()
Dim d, c, i%
Set d = CreateObject("scripting.dictionary")
Do
    d(Int(Rnd * Selection.Count + 1)) = ""
Loop Until d.Count = Selection.Count
For Each c In d.Keys
    i = i + 1
    Selection.Cells(i) = c
Next
Set d = Nothing
End Sub

香川群子

缺点是：
如果取到的随机数是和以前重复的，
就会无效而需要重新取随机值再试。
……

因此，如果范围够大的话，
运算会很浪费时间的。

我的代码中，集合中的数是用一个少一个的，
每次都是在剩下的集合元素中随机取值，
因此不会产生重复的。

香川群子

Sub RectangleDataRandom()
    Dim a
    Dim s As New Collection, t As New Collection
    Randomize
   
    a = Selection
   
    For i = 0 To UBound(a, 1) - 1
        For j = 0 To UBound(a, 2) - 1
            s.Add a(i + 1, j + 1)
            If b = "" Then b = b & a(i + 1, j + 1)
            t.Add 1 + j Mod UBound(a, 2) + (i Mod UBound(a, 1)) * UBound(a, 2)
        Next
    Next
   
    If b = "" Then
        For i = 1 To UBound(a, 1)
            For j = 1 To UBound(a, 2)
                k = Int(Rnd() * t.Count + 1)
                a(i, j) = t(k)
                t.Remove (k)
                '[a1].Resize(UBound(a, 1), UBound(a, 2)) = a
            Next
        Next
        
    Else
        For i = 1 To UBound(a, 1)
            For j = 1 To UBound(a, 2)
                k = Int(Rnd() * s.Count + 1)
                a(i, j) = s(k)
                s.Remove (k)
                '[a1].Resize(UBound(a, 1), UBound(a, 2)) = a
            Next
        Next
    End If
   
    [a1].Resize(UBound(a, 1), UBound(a, 2)) = a
   
End Sub

renyucai1963

香川群子 发表于 2010-5-28 22:14
Sub RectangleDataRandom()
    Dim a
    Dim s As New Collection, t As New Collection

回复5楼
我将代码复制到VBE窗口，运行出现“数据类型不匹配”对话框，请问哪里出了问题？
问题结解决了，原因是工作表里没数据，对不起。

renyucai1963

回复1楼
请问如何控制随机数的取值范围？
如在1<=（随机数）<=33
请香川群子帮助讲一讲，谢谢。