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

lc16whj

经常要增加或减少“班级表”中的学生，每次学生数量的改变，“各班座次表”的学生所在的班级就会错位，需要重新手动调整“各班座次表”的学生，让学生调整到相应的班级，很是麻烦。大神，能不能制作一个VBA宏代码，将“班级表”中的学生按班级分到“各班座次表”的相应班级中去，不改变“各班座次表”的结构！操作文件见附件！

沈默00

思路：如果现实中同班里没有重复的姓名，就用字典（班级+姓名）

chxw68

详见附件。

liulang0808

Sub 按钮1_Click()
    Set d = CreateObject("scripting.dictionary")
    arr = Sheets("班级").UsedRange
    For j = 2 To UBound(arr)
        If Len(arr(j, 3)) > 0 Then
            If Not d.exists(arr(j, 3)) Then
                Set d(arr(j, 3)) = CreateObject("scripting.dictionary")
            End If
            d(arr(j, 3))(j) = ""
        End If
    Next j
    Application.ScreenUpdating = False
    r = 1
    With Sheets("各班座次表")
        .UsedRange.ClearContents
        For Each k In d.keys
            .Cells(r, 1).Resize(1, 8) = arr
            .Cells(r, 10).Resize(1, 8) = arr
            c = 0
            rx = 1
            For Each kk In d(k).keys
                If rx = 33 Then
                    c = 9
                    rx = 1
                End If
                For i = 1 To 8
                    .Cells(rx + r, c + i) = arr(kk, i)
                Next i
                rx = rx + 1
            Next kk
            r = r + 33
        Next k
    End With
    Application.ScreenUpdating = True
End Sub

liulang0808

考试准考证号及座次表.zip (111.74 KB, 下载次数: 16)

2023-8-8 08:23 上传

点击文件名下载附件

如果都是按照第三列排序的，可以不使用字典，直接赋值数据也可以的

lc16whj

沈默00 发表于 2023-8-8 08:17
思路：如果现实中同班里没有重复的姓名，就用字典（班级+姓名）

姓名有重名字的同学！

limonet

能不能按“班级”分成工作表？这样子操作更简单。

chxw68

沈默00 发表于 2023-8-8 08:17
思路：如果现实中同班里没有重复的姓名，就用字典（班级+姓名）

这个实际上就是按班级拆分，与姓名没关系。

沈默00

chxw68 发表于 2023-8-8 08:51
这个实际上就是按班级拆分，与姓名没关系。

明白了，开始没理解是怎么分的

LIUZHU

如果装有WPS，可以试试运行JSA代码，简洁高效