考试排座系统

#排座系统#

• 网上现成的少（可能自己不会找）
• 用matlab等语言实现，有些慢
• Excel上运行VBA实现简单，基本每台电脑都安装有，方便

Sub 随机排座()
    Dim list_sheet As Worksheet

    Dim names(500) As String
    Dim name_count, max_name_count As Integer
    Dim column_capacities(50) As Integer
    Dim column_count, max_column_count As Integer
    Dim weights(500) As Double
    Dim d1, d2, d3 As Double
    Dim str1, str2 As String
    Dim i, j, k As Integer
    
    max_name_count = 200 '允许的最大学生数
    max_column_count = 20 '允许的最大列数（含走廊）
    
    Set list_sheet = ThisWorkbook.Sheets("输入人员")
        name_count = 0
    For i = 1 To max_name_count
       str1 = list_sheet.Cells(i, 1).Value
       str1 = Trim(str1)
       If str1 = "" Then
        Exit For
       Else
        name_count = name_count + 1
        names(name_count) = str1
       End If
    Next i
    

    For i = 1 To name_count
        weights(i) = Rnd()
    Next i
        
    For i = 1 To name_count - 1
        For j = 1 To name_count - i
            If weights(j) > weights(j + 1) Then
                d1 = weights(j)
                weights(j) = weights(j + 1)
                weights(j + 1) = d1
                str1 = names(j)
                names(j) = names(j + 1)
                names(j + 1) = str1
            End If
        Next j
    Next i
    

    column_count = 0
    Set list_sheet = ThisWorkbook.Sheets("输入布局")
    For i = 2 To max_column_count
        str1 = list_sheet.Cells(i, 1).Value
        str1 = Trim(str1)
        If str1 = "" Then
         Exit For
        Else
         column_count = column_count + 1
         column_capacities(column_count) = Int(str1)
        End If
    Next i
    
    Application.ScreenUpdating = False
    
        
    '颜色
    Dim c1, c2, chead As Variant
    chead = list_sheet.Cells(2, 4).Interior.Color
    c1 = list_sheet.Cells(3, 4).Interior.Color
    c2 = list_sheet.Cells(4, 4).Interior.Color
            
    
    Set list_sheet = ThisWorkbook.Sheets("随机排座")
    For i = 1 To 30
        For j = 1 To max_column_count
            list_sheet.Cells(i, j).Value = ""
            list_sheet.Cells(i, j).Interior.Color = RGB(255, 255, 255)
        Next j
    Next i


    If column_count > 0 Then
        list_sheet.Cells(1, column_count / 2).Value = "讲台"
    End If
        
    
    k = 1
    For i = 1 To column_count
        If column_capacities(i) = 0 Then
            str1 = "走廊"
        Else
            str1 = "第" + Trim(Str(k)) + "列"
            k = k + 1
        End If
        list_sheet.Cells(1 + 1, i).Value = str1
        list_sheet.Cells(1 + 1, i).Interior.Color = chead
    Next i
    k = 1
    Dim lines As Integer
    lines = 0
    For i = 1 To column_count
        For j = 1 To column_capacities(i)
             If k > name_count Then
             Exit For
             End If
               list_sheet.Cells(j + 1 + 1, i).Value = names(k)
               If j + 2 > lines Then
                    lines = j + 2
               End If
               If j Mod 2 = 0 Then
                    list_sheet.Cells(j + 1 + 1, i).Interior.Color = c1
               Else
                    list_sheet.Cells(j + 1 + 1, i).Interior.Color = c2
               End If
               k = k + 1
               Next j
               If k > name_count Then
                 Exit For
               End If
    Next i
    For i = 2 To lines
        For j = 1 To column_count
            list_sheet.Cells(i, j).Borders.LineStyle = xlContinuous
        Next j
    Next i
    
    Application.ScreenUpdating = True

End Sub

备注：Excel代码是同事写的，没经过同意(应该也不介意，好东西大家一起分享)；

使用方法：

1. 打开EXCEL，再按下键盘组合键 alt＋F11  打开VBA编辑器；

2. 菜单“插入”--->选“模块”，弹出的模块，将上面的代码粘贴上，保存。