请各位大佬帮下忙按要求完成，感谢

szxwhysl

请各位大佬帮下忙按要求完成，感谢

DevilW

啥也没说，好像啥都做了

ynzsvt

啥也不需要干，就已经完成了。

szxwhysl

ynzsvt 发表于 2024-10-7 20:17
啥也不需要干，就已经完成了。

　没有代码

quqiyuan

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

quqiyuan

代码如下。。。
Sub test()
    Dim wb As Workbook, sht As Worksheet
    Set wb = ThisWorkbook
    Set sht = wb.Sheets("sheet1")
    arr = sht.[a1].CurrentRegion
    Set d = CreateObject("scripting.dictionary")
    ReDim brr(1 To UBound(arr), 1 To 1)
    For i = 2 To UBound(arr)
        s = arr(i, 1)
        If Not d.exists(s) Then Set d(s) = CreateObject("scripting.dictionary")
        d(s)(i) = i
    Next
    m = 0
    brr(1, 1) = "考室号"
    For Each k In d.keys
        m = m + 1: x = 0
        For Each i In d(k).keys
            x = x + 1
            If x > 35 Then m = m + 1: x = 0: brr(i, 1) = "第" & m & "考室" Else brr(i, 1) = "第" & m & "考室"
        Next
    Next
    Set d = Nothing
    sht.[n1].Resize(UBound(brr)) = brr
    Beep
End Sub

szxwhysl

quqiyuan 发表于 2024-10-7 21:13
代码如下。。。
Sub test()
    Dim wb As Workbook, sht As Worksheet

不对，当把A列全变为1小名后，有的考室有36人

quqiyuan

szxwhysl 发表于 2024-10-8 13:28
不对，当把A列全变为1小名后，有的考室有36人