分阶段如何编排考场？

sxo · 发表于 2023-5-5 13:31

本帖最后由 sxo 于 2023-5-5 20:57 编辑

实现功能：共3个考场，每个考场可容纳45人，3个考场可在同一时间段内考试。每个考场有15场次。

希望序号在1000以后的学生全部安排在14:30后的场次，怎么改进代码？

sxo · 发表于 2023-5-5 15:07

不要沉了。

半百 · 发表于 2023-5-5 15:31

sxo · 发表于 2023-5-5 15:35

半百发表于 2023-5-5 15:31

具体见压缩文件

sxo · 发表于 2023-5-5 17:05

sxo · 发表于 2023-5-5 20:19

本帖最后由 sxo 于 2023-5-5 20:24 编辑

<div class="blockcode"><blockquote>Dim Arr(), Brr(), crr()
Dim drr As Variant
Dim strarray() As Variant
Set drr = Sheets("3¡′Îê±¼ä")
strarray = drr.Range("A2:C16").Value
Dim i%, j%, n%, m%, hm%, zs%, h% 'hm′ú±íË3DòoÅ￡¬zs′ú±íÃ¿¸ö3¡′ÎèËêy
hm = 1
zs = 45
Set D = CreateObject("scripting.dictionary")
ReDim Brr(1 To 1070, 1 To 6)
For i = 1 To UBound(strarray) '3¡′Î
m = 0
For j = 1 To 3 '¿¼3¡êy
For h = 1 To zs '×ùÎ»êy
n = n + 1
m = m + 1
' hm = hm + 1
Brr(n, 1) = hm 'oÅ
hm = hm + 1
Brr(n, 2) = j '¿¼3¡
Brr(n, 3) = i '3¡′Î
Brr(n, 4) = IIf(m Mod zs, m Mod zs, zs) '×ùÎ»oÅ
Brr(n, 5) = strarray(i, 2)
Brr(n, 6) = strarray(i, 3)
D(Brr(n, 1)) = n 'óÃ×Öμä¼ÇÂ¼¿¼oÅËùÔúμÄDDoÅ￡¬¡±
Next
Next
Next
' End With
With Sheets("Ñ§éú±í")
.Activate
Arr = .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row).Value
ReDim crr(1 To UBound(Arr), 1 To 5)
For i = 1 To UBound(Arr)
If D.Exists(Arr(i, 1)) Then
n = D(CStr(Arr(i, 1)))
For j = 2 To UBound(crr, 2) + 1
crr(i, j - 1) = Brr(n, j)
Next
End If
Next
.[C2].Resize(UBound(crr), 5) = crr
End With

复制代码

sxo · 发表于 2023-5-6 09:36

顶顶。

半百 · 发表于 2023-5-6 10:21

3190496160 · 发表于 2023-5-6 11:23

Sub 分段安排()
With Sheets("场次时间")
ar = .Range("A2:C16").Value
End With
With Sheets("学生表")
.[a1].CurrentRegion.Offset(1, 2) = Empty
br = .[a1].CurrentRegion
For i = 2 To 1001 Step 135
      ci = ci + 1 ''场次
      kch = 0 ''考场号
      For s = i To i + 134 Step 45
         zwh = 0 ''座位号
         kch = kch + 1 ''考场号
         For ss = s To s + 44
            If ss <= 1001 Then
                  zwh = zwh + 1
                  br(ss, 3) = kch
                  br(ss, 4) = ci
                  br(ss, 5) = zwh
                  br(ss, 6) = ar(ci, 2)
                  br(ss, 7) = ar(ci, 3)
            End If
         Next ss
      Next s
Next i
ci = 8
For i = 1002 To UBound(br) Step 135
      ci = ci + 1 ''场次
      kch = 0 ''考场号
      For s = i To i + 134 Step 45
         zwh = 0 ''座位号
         kch = kch + 1 ''考场号
         For ss = s To s + 44
            If ss <= UBound(br) Then
                  zwh = zwh + 1
                  br(ss, 3) = kch
                  br(ss, 4) = ci
                  br(ss, 5) = zwh
                  br(ss, 6) = ar(ci, 2)
                  br(ss, 7) = ar(ci, 3)
            End If
         Next ss
      Next s
Next i

.[a1].CurrentRegion = br
End With
MsgBox "ok!"
End Sub
Sub 全部安排()
With Sheets("场次时间")
ar = .Range("A2:C16").Value
End With
With Sheets("学生表")
.[a1].CurrentRegion.Offset(1, 2) = Empty
br = .[a1].CurrentRegion
For i = 2 To UBound(br) Step 135
      ci = ci + 1 ''场次
      kch = 0 ''考场号
      For s = i To i + 134 Step 45
         zwh = 0 ''座位号
         kch = kch + 1 ''考场号
         For ss = s To s + 44
            If ss <= UBound(br) Then
                  zwh = zwh + 1
                  br(ss, 3) = kch
                  br(ss, 4) = ci
                  br(ss, 5) = zwh
                  br(ss, 6) = ar(ci, 2)
                  br(ss, 7) = ar(ci, 3)
            End If
         Next ss
      Next s
Next i
.[a1].CurrentRegion = br
End With
MsgBox "ok!"
End Sub

3190496160 · 发表于 2023-5-6 11:26

提供两种方式，供参考

实例.rar (35.31 KB, 下载次数: 13)

		自动登录	找回密码
密码			免费注册

[求助] 分阶段如何编排考场？

评分