请教一个自动列举的问题，请老师指导一下！

剑指天南

刚开始学习VBA，想请教一个自动列举的问题，已做好附件上传！请老师们指导一下！

剑指天南

刚刚附件可能没有上传成功！现补上！

半百

Sub TEST()
With Sheets("原始数据")
    R = .Cells(Rows.Count, 2).End(3).Row + 1
    ARR = .Range("A1:C" & R)
End With
N = 1
With Sheets("名单")
    For I = 2 To UBound(ARR)
        If ARR(I, 2) <> ARR(I - 1, 2) Then
            If R1 > 0 Then
                .Cells(R1, 2) = M
                .Cells(R1, 1).Resize(1, 7).Interior.ColorIndex = 40
            End If
            J = 1: M = 0
            N = N + 1
            R1 = N
            .Cells(N, 1) = ARR(I, 2)
            N = N + 1
            .Cells(N, 1) = ARR(I, 3)
            M = M + 1
        Else
            J = J + 1
            If J = 8 Then
                J = 1
                N = N + 1
            End If
            .Cells(N, J) = ARR(I, 3)
            M = M + 1
        End If
    Next
End With
End Sub

yylucke

请参见附件
求助一个入门的循环代码.rar (38.5 KB, 下载次数: 6)

2019-9-6 16:52 上传

点击文件名下载附件

剑指天南

半百 发表于 2019-9-6 16:18
Sub TEST()
With Sheets("原始数据")
    R = .Cells(Rows.Count, 2).End(3).Row + 1

谢谢半百老师，您写的代码完全达到我的要求，并且思路也很清晰！对于初学者，容易理解！谢谢您！

剑指天南

yylucke 发表于 2019-9-6 16:52
请参见附件

谢谢yylucke老师，您的代码我测试了，非常好！并且比我预想的还要复杂多变！虽说以我现在的能力还很费劲！但也给了我一些思路！非常感谢！希望以后还能得到您的指点！

yylucke

剑指天南 发表于 2019-9-6 20:21
谢谢yylucke老师，您的代码我测试了，非常好！并且比我预想的还要复杂多变！虽说以我现在的能力还很费劲 ...

你客气了，我也只是一个爱好者，远达不到老师的水平。
我解决你提出问题的思路是：
1、人员要随机，否则每次自动生成均是一样的数据
2、要根据预先选择的部门和对应人数从人员名单抓取人名
3、简单美化生成的表格
其实，比较麻烦的是随机生成及不能在同一次生成中重复
用到了字典功能、一个简单的不重复的随机数生成代码
另，其实代码还需要完善：即1、当设定的部门人数大于人员表中对应部门人数的时候，应报错；2、设定的部门在人员表中不存在的时候应报错。