请教一个随机分组的问题

香川群子

完全按照楼主要求，直线思考的代码如下：

Sub test()
    Dim i&, i2&, j&, k&, m&, n&, r&, s&, t&, z&, tms#
   
    tms = Timer
    [a1].CurrentRegion.Interior.ColorIndex = 0
    [a1].CurrentRegion = ""
   
    m = 100 '取数范围m
    n = 50 '每组个数n
    s = 25 '相同个数s
    z = 3 '组数z
   
    ReDim a&(z, m), c&(z, m)
    For j = 1 To m
        a(0, j) = j
    Next
   
   
    For i = 1 To z '遍历组
        a(i, 0) = i
        For j = 1 To m
            a(i, j) = a(i - 1, j)
        Next
        
        Randomize
        For j = 1 To m '组个数
            Do
                k = k + 1
                r = Int(Rnd * (m - j + 1)) + j
                t = a(i, r): a(i, r) = a(i, j): a(i, j) = t
                If j > s Then
                    Exit Do
                Else
                    For i2 = 1 To i - 1
                       If c(i2, t) = 0 Then Exit For
                    Next
                    If i2 = i Then Exit Do
                End If
            Loop
            If j <= n Then c(i, t) = 1: c(0, t) = c(0, t) + 1
        Next
    Next
   
    [a1].Resize(z + 1, m + 1) = a
    For i = 1 To z
        For j = 1 To n
            If c(0, a(i, j)) = z Then Cells(i + 1, j + 1).Interior.ColorIndex = 7
        Next
    Next
    MsgBox Format(Timer - tms, "0.000s ") & k
End Sub

zopey

集合运算
A ∪ B ∪ C = A+B+C -(A ∩ B +B ∩ C +C ∩ A)+A ∩ B ∩ C

代入条件
      100    >= 50 +50 +50 - （25+25+25） + A ∩ B ∩ C

推导出
         A ∩ B ∩ C <= 25

zopey

第一组：1-50
第二组：全单1 3 5 7 ... ... 95 97 99
第三组：1-25 + 76-100
第四组：1-12 + 25-37+51-62 +74 + 77-88

从韦恩图 计算
4 组集合的 并集 =13*4+6*8+7=107个 元素 （至少）

zopey

韦恩图不同的相交区域为2^n个；
四个集合相交的韦恩图，有效的有15个区域。

下图才是正确的 画法。

zopey

把 不同区域的 数字 加起来 ，楼主给的 4组数 的并集  
    =7*5+ 6*10 =95  元素

（<=100） 是一种 合理的组合。

zopey

5个集合 有效的 不同区域应该是  =2^5-1= 31

yjh_27

gensen 发表于 2018-9-30 15:29
嗯，是的，两组之间有25个相同数就可以，但各组不能都是完全固定一模一样的25个数字。

这个是可能的， ...

从前26中随机取25个，有26种取法。其余25个随机从后74中取。

zopey

Private Sub CommandButton1_Click()
Cells.ClearContents
Dim m&, n&, r&, s&, z&

    m = 100 '取数范围m
    n = 50 '每组个数n
    s = 25 '相同个数s
    z = 3 '组数z

For i = 1 To m
    Cells(i, 1) = Rnd()
    Cells(i, 2) = i
Next

Columns("A:B").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess

Dim arr, brr(), r1, r2, r3
arr = [b1].Resize(m, 1)
ReDim brr(1 To m, 1 To z)

r1 = Int(Rnd() * (s + 1))
r2 = s - r1
r3 = n - s - r2

For i = 1 To r1
For j = 1 To z
    brr(i, j) = arr(i, 1)
Next
Next


For i = 1 To r2 * z
    k = Int((i - 1) / r2)
    If k = 0 Then
       brr(r1 + i, 1) = arr(r1 + i, 1)
       brr(r1 + i, 2) = arr(r1 + i, 1)
    ElseIf k = 1 Then
       brr(r1 + i, 2) = arr(r1 + i, 1)
       brr(r1 + i, 3) = arr(r1 + i, 1)
    ElseIf k = 2 Then
       brr(r1 + i, 3) = arr(r1 + i, 1)
       brr(r1 + i, 1) = arr(r1 + i, 1)
    End If
Next

For i = 1 To r3 * z
    k = Int((i - 1) / r3)
    brr(r1 + r2 * z + i, k+1) = arr(r1 + r2 * z + i, 1)
Next

[d1].Resize(m, z) = brr
End Sub

z=3（3个集合） 比较简单，拿来练练手 3集合交集.rar (12.17 KB, 下载次数: 2)

2018-10-2 08:56 上传

点击文件名下载附件

zopey

按图索画

4集合交集.rar (13.34 KB, 下载次数: 7)

2018-10-2 10:30 上传

点击文件名下载附件

gensen

zopey 发表于 2018-10-2 10:30
按图索画

非常感谢，学到了很多