ExcelVBA联考中学校自动分配

 

Private Sub CommandButton1_Click()
  With Sheet1
    r = 2 '数据从第2行开始
    t = .Cells(r, 15).Value '获取第r行第15列的值即第一个学校名称
    Do Until t = "" '循环直到获得的单元格内容为空
      'MsgBox (t)
      n = Application.WorksheetFunction.CountIf(.Range("o:o"), .Cells(r, 15)) '计算n列第r行第15列单元格的个数
      'MsgBox (n)
      'Sheets.Add '插入一个新的工作表
      'Sheets("sheet1").Range("a1:p1").Copy Sheets("1").Range("n1") '将表头复制到新表
      Sheets("sheet1").Cells(r, 1).Resize(n, 16).Copy Sheets(t + 1).Range("a2") '从第r行第1列开始向右向下扩展n行4列复制到新表的a2
      r = r + n '获取下一个学校所在行号
      t = .Cells(r, 15).Value '第2句注释
    Loop
  End With
End Sub