表格需要实现一个功能,函数没有办法实现,于是就让Deepseek帮忙写了代码,但是,运行宏的时候,没有这个宏,特来求解。
(我的要求是,专业人数比对考场容纳人数,专业人数少于考场容纳人数情况下,对应的行列交叉单元格显示“ok”,专业人数大于考场容纳人数情况下,多个考场容纳人数相加,同专业考场尽可能少,对应的行和列交叉对应单元格显示"and",一个考场只能使用一次。一个专业可以多个考场,但是一个考场只能一个专业。如果考场都安排完了,还有专业没有考场,则此专业的行都显示NO)
Sub AllocateClassroomsOptimized()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("教室安排") ' 设置工作表
Dim lastRow As Long, lastCol As Long
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' 获取专业最后一行
lastCol = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column ' 获取考场最后一列
Dim i As Long, j As Long
Dim studentCount As Long, classroomCapacity As Long
Dim remainingStudents As Long
Dim isAllocated As Boolean
Dim allocatedClassrooms As Collection ' 用于记录已分配的考场
' 初始化已分配考场集合
Set allocatedClassrooms = New Collection
' 遍历每个专业
For i = 3 To lastRow
studentCount = ws.Cells(i, 2).Value ' 获取专业人数
remainingStudents = studentCount
isAllocated = False
' 按考场容量从小到大排序分配
For j = lastCol To 3 Step -1
classroomCapacity = ws.Cells(2, j).Value ' 获取考场容量
' 如果考场未被分配且剩余学生数大于0
If Not IsInCollection(allocatedClassrooms, CStr(j)) And remainingStudents > 0 Then
If remainingStudents <= classroomCapacity Then
' 如果剩余学生数小于等于考场容量,分配为"ok"
ws.Cells(i, j).Value = "ok"
remainingStudents = 0
isAllocated = True
allocatedClassrooms.Add j, CStr(j) ' 标记考场为已分配
Else
' 如果剩余学生数大于考场容量,分配为"and"
ws.Cells(i, j).Value = "and"
remainingStudents = remainingStudents - classroomCapacity
allocatedClassrooms.Add j, CStr(j) ' 标记考场为已分配
End If
End If
Next j
' 如果学生未完全分配,整行显示"NO"
If remainingStudents > 0 Then
For j = 3 To lastCol
ws.Cells(i, j).Value = "NO"
Next j
End If
Next i
MsgBox "分配完成!"
End Sub
' 辅助函数:检查某个考场是否已被分配
Function IsInCollection(col As Collection, key As String) As Boolean
On Error Resume Next
IsInCollection = Not IsEmpty(col(key))
On Error GoTo 0
End Function
(我的要求是,专业人数比对考场容纳人数,专业人数少于考场容纳人数情况下,对应的行列交叉单元格显示“ok”,专业人数大于考场容纳人数情况下,多个考场容纳人数相加,同专业考场尽可能少,对应的行和列交叉对应单元格显示"and",一个考场只能使用一次。一个专业可以多个考场,但是一个考场只能一个专业。如果考场都安排完了,还有专业没有考场,则此专业的行都显示NO)
Sub AllocateClassroomsOptimized()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("教室安排") ' 设置工作表
Dim lastRow As Long, lastCol As Long
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' 获取专业最后一行
lastCol = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column ' 获取考场最后一列
Dim i As Long, j As Long
Dim studentCount As Long, classroomCapacity As Long
Dim remainingStudents As Long
Dim isAllocated As Boolean
Dim allocatedClassrooms As Collection ' 用于记录已分配的考场
' 初始化已分配考场集合
Set allocatedClassrooms = New Collection
' 遍历每个专业
For i = 3 To lastRow
studentCount = ws.Cells(i, 2).Value ' 获取专业人数
remainingStudents = studentCount
isAllocated = False
' 按考场容量从小到大排序分配
For j = lastCol To 3 Step -1
classroomCapacity = ws.Cells(2, j).Value ' 获取考场容量
' 如果考场未被分配且剩余学生数大于0
If Not IsInCollection(allocatedClassrooms, CStr(j)) And remainingStudents > 0 Then
If remainingStudents <= classroomCapacity Then
' 如果剩余学生数小于等于考场容量,分配为"ok"
ws.Cells(i, j).Value = "ok"
remainingStudents = 0
isAllocated = True
allocatedClassrooms.Add j, CStr(j) ' 标记考场为已分配
Else
' 如果剩余学生数大于考场容量,分配为"and"
ws.Cells(i, j).Value = "and"
remainingStudents = remainingStudents - classroomCapacity
allocatedClassrooms.Add j, CStr(j) ' 标记考场为已分配
End If
End If
Next j
' 如果学生未完全分配,整行显示"NO"
If remainingStudents > 0 Then
For j = 3 To lastCol
ws.Cells(i, j).Value = "NO"
Next j
End If
Next i
MsgBox "分配完成!"
End Sub
' 辅助函数:检查某个考场是否已被分配
Function IsInCollection(col As Collection, key As String) As Boolean
On Error Resume Next
IsInCollection = Not IsEmpty(col(key))
On Error GoTo 0
End Function