把分组后的姓名显示在单元格里

ykcbf1100

yshcy 发表于 2025-1-28 10:54
意思是出来了。但能否把姓名放在不同的单元里，而不是合并呢？谢谢

这行改一下。

brr是一维数组，所以不用转换

3190496160

Sub 横排模式()
Dim arr As Variant
Dim br()
arr = Range("a1").CurrentRegion
Set dic = CreateObject("scripting.dictionary")
j = Cells(Rows.Count, 1).End(xlUp).Row - 1
k = InputBox("请输入生成的组数", "组数", "5")
If k * 5 > j Then MsgBox "不足以生成" & k & "组，请重新输入": End
ReDim br(1 To k, 1 To 5)
For i = 1 To k
    n = n + 1: y = 0
    Do
        sjs = Application.RandBetween(2, UBound(arr))
        If Not dic.exists(sjs) Then
            y = y + 1
            If y > 5 Then GoTo 10
            br(n, y) = arr(sjs, 1)
            dic(sjs) = ""
        End If
    Loop
10:
Next i
[d1].Resize(n, 5) = br
MsgBox "ok!"
End Sub
Sub 竖排模式()
Dim arr As Variant
Dim br()
arr = Range("a1").CurrentRegion
Set dic = CreateObject("scripting.dictionary")
j = Cells(Rows.Count, 1).End(xlUp).Row - 1
k = InputBox("请输入生成的组数", "组数", "5")
If k * 5 > j Then MsgBox "不足以生成" & k & "组，请重新输入": End
ReDim br(1 To k * 5 + k, 1 To 1)
For i = 1 To k
    y = 0
    Do
        sjs = Application.RandBetween(2, UBound(arr))
        If Not dic.exists(sjs) Then
            y = y + 1
            If y > 5 Then GoTo 10
            n = n + 1
            br(n, 1) = arr(sjs, 1)
            dic(sjs) = ""
        End If
    Loop
10:
    n = n + 1
Next i
[m1].Resize(n, 1) = br
MsgBox "ok!"
End Sub

3190496160

提供两种显示模式，自己选择呗
把分组后的姓名显示在单元格里.rar (16.45 KB, 下载次数: 4)

2025-1-28 11:11 上传

点击文件名下载附件

gwjkkkkk

草爷回复了，我不写了。。。

quqiyuan

参与一下，仅供参考。。。

quqiyuan

代码如下。。。
Sub test0128()
    Dim arr(), brr(), dic, i, j, k, x, y, m, n
    j = Cells(Rows.Count, 1).End(xlUp).Row - 1
    arr = Range("a2").Resize(j)
100:
    k = InputBox("请输入生成的组数")
    If k * 5 > j Then MsgBox "不足以生成" & k & "组，请重新输入": GoTo 100:
    ReDim brr(1 To k, 1 To 5)
    For x = 1 To k
        For y = 1 To 5
            brr(x, y) = arr(5 * (x - 1) + y, 1)
        Next y
    Next x
    [d1].CurrentRegion.ClearContents
    [d1].Resize(k, 5) = brr
End Sub

ph378

学习学习了

wang-way

https://club.excelhome.net//forum.php?mod=viewthread&tid=1539996&extra=  参考一下

chxw68

参与练习。