VBA考试安排

laoyang8023

求助各位大神，，我打开，生成各班信息后，，，只有41班考号是文本格式，42 43 44都是常规格式，，，最前面的0没有，，，在模板也设置考号是文本格式，，但是只有41是文本格式，，麻烦大神帮忙处理一下，一键生成都是文本格式的。

wang-way

你若急用 我分享一个插件给你用几天

laoyang8023

wang-way 发表于 2021-4-6 22:52
你若急用 我分享一个插件给你用几天

麻烦你发过来

wang-way

自己修改一下吧

3190496160

Sub 分班信息()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim d1 As New Dictionary, d2 As New Dictionary, arr, brr, m%
    For Each sht In Sheets
        If sht.Name Like "*班" Then
            sht.Delete
        End If
    Next
    arr = Sheets("考生信息").Range("A1").CurrentRegion
    For i = 2 To UBound(arr)
        d1(Mid(arr(i, 1), 5, 2)) = ""
        d2(Mid(arr(i, 1), 5, 2) & arr(i, 2)) = i
    Next
    With Sheets("各班考生信息")
        For Each k In d1.Keys
            s = Filter(d2.Keys, k): .[d1] = Val(k)
            ReDim brr(1 To 100, 1 To 6)
            For Each c In s
                m = m + 1
                brr(m, 1) = m
                For j = 2 To UBound(brr, 2)
                    brr(m, j) = arr(d2(c), j - 1)
                Next
            Next
            .Copy after:=Sheets(Sheets.Count)
             Sheets(Sheets.Count).[a3].Resize(m, 6) = brr
             Sheets(Sheets.Count).[a3].Resize(m, 6).Borders.LineStyle = 1
            ActiveSheet.Name = .[d1] & "班": m = 0
            .[d1] = ""
        Next
    End With
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

3190496160

VBA考试安排.rar (238.68 KB, 下载次数: 35)

2021-4-6 23:04 上传

点击文件名下载附件

3190496160

一个简单的考场安排，弄得如此复杂，简单两个按钮就可以搞定的事情呀

zhyj_88

            ActiveSheet.Name = .[d1] & "班": m = 0
            .[a3:f200].ClearContents

将上面的Clear改为ClearContents

zpy2

select 班级,group_concat(考号||姓名||考场||座号||考场地点) 子表 from (select substr(考号,5,2) 班级,* from 考生考场信息明细表) group by 班级

laoyang8023

统一回复一下，，真心的谢谢你们。