制作一个VBA宏代码，将“班级表”中的学生按班级分到“各班座次表”的相应班级中

LIUZHU

用WPS软件测试

lc16whj

liulang0808 发表于 2023-8-8 08:23
如果都是按照第三列排序的，可以不使用字典，直接赋值数据也可以的

谢谢大神，节省了不少操作时间，请问，如果学生中有相同的名字，会影响“各班座次表”的分班结果吗？

yynrzwh

考试准考证号及座次表.rar (180.71 KB, 下载次数: 12)

2023-8-8 10:46 上传

点击文件名下载附件

chxw68

lc16whj 发表于 2023-8-8 09:16
谢谢大神，节省了不少操作时间，请问，如果学生中有相同的名字，会影响“各班座次表”的分班结果吗？

规则是你自己定的，这个得问你自己。

liulang0808

lc16whj 发表于 2023-8-8 09:16
谢谢大神，节省了不少操作时间，请问，如果学生中有相同的名字，会影响“各班座次表”的分班结果吗？

目前的处理方式跟名字没有关系，是否有影响，看楼主的要求

lc16whj

limonet 发表于 2023-8-8 08:51
能不能按“班级”分成工作表？这样子操作更简单。

工作表太多，不方便打印

准提部林

班級有排序的話. 使用公式應較靈活(自動與源表更新),
打印的話, 可寫簡單的代碼~~連續或跳選指定班級~~

lc16whj

liulang0808 发表于 2023-8-8 08:23
如果都是按照第三列排序的，可以不使用字典，直接赋值数据也可以的

大神，能不能再帮忙制作一个VBA宏代码，将“班级表”中的学生按考场分到“考场座位表”的相应考场中去，注意：“班级表”中的序号和考场这两列不要，“考场座位表”每个考场31行，A列留白，从B列开始,见“考场座位表”效果图（“考场座位表”效果图中有五十多个学生，是我为超过30个考生预留的）。不改变“考场座位表”的结构！操作文件见附件！

liulang0808

Sub 按钮1_Click()
    Set d = CreateObject("scripting.dictionary")
    brr = Sheets("班级").[c1:h1]
    arr = Sheets("班级").UsedRange
    For j = 2 To UBound(arr)
        If Len(arr(j, 2)) > 0 Then
            If Not d.exists(arr(j, 2)) Then
                Set d(arr(j, 2)) = CreateObject("scripting.dictionary")
            End If
            d(arr(j, 2))(j) = ""
        End If
    Next j
    Application.ScreenUpdating = False
    r = 1
    With Sheets("考场座位表")
        .UsedRange.ClearContents
        For Each k In d.keys
            .Cells(r, 2).Resize(1, 6) = brr
            .Cells(r, 9).Resize(1, 6) = brr
            c = -1
            rx = 1
            For Each kk In d(k).keys
                If rx = 32 Then
                    c = 6
                    rx = 1
                End If
                For i = 3 To 8
                    .Cells(rx + r, c + i) = arr(kk, i)
                Next i
                rx = rx + 1
            Next kk
            r = r + 31
        Next k
    End With
    Application.ScreenUpdating = True
End Sub

liulang0808

考试考场座位安排表.zip (102.91 KB, 下载次数: 16)

2023-8-8 19:38 上传

点击文件名下载附件

模拟结果供参考