修改的代码为“模块3后续调配”的第一个过程“Public Sub xutiao() '后续调配:完全匹配”中的几句代码:
- For i = 2 To h '转换男为100,女为0
- If jcsj(i, xbl) = "男" Then jcsj(i, xbl) = 100 Else jcsj(i, xbl) = 0
- Next i
- Erase xsbj: ReDim xsbj(2 To h, 1 To 4)
- For i = 2 To h '动态写入未调配学生科目、性别参差信息
- If jcsj(i, bjl) = "" Then
- pingj = 分班信息.[j3].Resize(1, 4).Value
- biaoj = 分班信息.[o4].Resize(n, 4).Value
- If jcsj(i, ywl) < pingj(1, 1) Then xsbj(i, 1) = 0 Else xsbj(i, 1) = 1
- If jcsj(i, sxl) < pingj(1, 2) Then xsbj(i, 2) = 0 Else xsbj(i, 2) = 1
- If jcsj(i, zhl) < pingj(1, 3) Then xsbj(i, 3) = 0 Else xsbj(i, 3) = 1
- If jcsj(i, xbl) < pingj(1, 4) Then xsbj(i, 4) = 0 Else xsbj(i, 4) = 1
- ' xsbj(i, 5) = xsbj(i, 1) & xsbj(i, 2) & xsbj(i, 3) & xsbj(i, 4)
- End If
- Next i
- m = 0: m1 = 0
- For i = 2 To h '寻找完全匹配学生
- If jcsj(i, bjl) = "" Then
- For j = 1 To n
- gs2 = (xsbj(i, 1) + biaoj(j, 1) = 1) + (xsbj(i, 2) + biaoj(j, 2) = 1) + (xsbj(i, 3) + biaoj(j, 3) = 1) + (xsbj(i, 4) + biaoj(j, 4) = 1)
- ' If xsbj(i, 5) = biaoj(j, 5) Then
- If -gs2 = 4 Then
- pph = i: ppb = j: hh(ppb) = hh(ppb) + 1: m = 1 '下句用于控制各班人数的均衡
- If hh(ppb) - WorksheetFunction.Min(hh) < 2 Then GoTo 100 Else hh(ppb) = hh(ppb) - 1: m = 0
- End If
- Next j
- End If
- Next i
复制代码 注释掉的是出错的代码…… |