把学生按要求分组，很难。

s8th

请各位高手参照我的文件，第一组是原始数据，要求生成5组数据


规则是：

每一组都是3*5 个数据

每一个数据在分组后，都要改变原来的横纵坐标，并且不重复

比如我手工分了两组，大家可以看到比如1，在下面的分组中，就不是在第一列，也不在第一行。


请大家帮忙谢谢

darklesson

这有什么难度？？把数组变成一维，洗牌后重新写回二维就好了吧

s8th

darklesson 发表于 2023-3-29 12:56
这有什么难度？？把数组变成一维，洗牌后重新写回二维就好了吧

不太会。。。可否指导一下？

darklesson

Sub Test()
Dim i%, a%, k%, m%
Dim arry(1 To 15), arry1(1 To 15), num(1 To 5, 1 To 3), num2 As New Collection
VBA.Randomize
For i = 1 To 15
num2.Add i
Next i

For i = 1 To num2.Count
r = Int(Rnd * num2.Count) + 1: arry(i) = num2(r): num2.Remove (r)
Next i

a = Int(Rnd * 5) + 1

Do
k = 0: m = m + 1
For i = a + m To 15
k = k + 1: arry1(k) = arry(i)
Next i
For i = 1 To a + m - 1
k = k + 1: arry1(k) = arry(i)
Next i

    r = 1: c = 1
    For i = 1 To 15
    num(r, c) = arry1(i)
        If c = 3 Then
        r = r + 1: c = 1
        Else
        c = c + 1
        End If
    Next i
ActiveSheet.Cells(m * 6, 5).Resize(5, 3) = num
Loop Until m = 10
End Sub

darklesson

指导不存在，相互学习。

s8th

darklesson 发表于 2023-3-29 14:33
指导不存在，相互学习。

你好，这个似乎没有实现要求，比如第一组 1在第一行第一列，第二组1就不能在第一行第一列。

s8th

顶一下。还要符合长度

kkf5560

每个数标注他的坐标，然后依次给他xy增量即可

吴中泉

花了一点时间编写,看看可行?

1. Sub 随机分配五组3X5个不重数据()
   
2.     Dim arr(1 To 15), i, j, k, m, n, x
   
3.     '初始化数组(不重复15个数)
   
4.     For i = 1 To 15
   
5.         arr(i) = i
   
6.     Next
   
7.     '产生五组
   
8.     n = 7
   
9.     For m = 1 To 5
   
10.         '打乱顺序(洗牌)
    
11.         For i = 1 To 15
    
12.             j = Int(Rnd(1) * 100) Mod 15 + 1
    
13.             k = Int(Rnd * 15) + 1
    
14.             x = arr(j): arr(j) = arr(k): arr(k) = x
    
15.         Next i
    
16.         
    
17.         Cells(n, [I1].Column) = "第" & m & "组"
    
18.         '相应区域写入3X5不重复乱序数据
    
19.         For i = 1 To 5
    
20.             For j = 1 To 3
    
21.                 Cells(n + i - 1, j + [I1].Column) = arr(j * i)
    
22.             Next j
    
23.         Next i
    
24.         n = n + 8
    
25.     Next m
    
26. End Sub
    

复制代码

补充内容 (2023-4-3 20:00):
这段代码有误,10楼已订正.符合楼主要求的代码在13楼.

吴中泉

发个代码须要审核?
直接贴上吧:
Sub 随机分配五组3X5个不重数据()
    Dim arr(1 To 15), i, j, k, m, n, x
    '初始化数组(不重复15个数)
    For i = 1 To 15
        arr(i) = i
    Next
    '产生五组
    n = 7
    For m = 1 To 5
        '打乱顺序(洗牌)
        For i = 1 To 15
            j = Int(Rnd(1) * 100) Mod 15 + 1
            k = Int(Rnd * 15) + 1
            x = arr(j): arr(j) = arr(k): arr(k) = x
        Next i
        
        Cells(n, [I1].Column) = "第" & m & "组"
        '相应区域写入3X5不重复乱序数据
        For i = 1 To 5
            For j = 1 To 3
                Cells(n + i - 1, j + [I1].Column) = arr(j * i)
            Next j
        Next i
        n = n + 8
    Next m
End Sub




补充内容 (2023-4-1 21:17):
订正以下一行代码，才实现我想要的效果，但不符合楼主的要求。
        '相应区域写入3X5不重复乱序数据
Cells(n + i - 1, j + [I1].Column) = arr((i - 1) * 3 + j)