Excel VBA期末报告：自动生成成绩表和分类统计

{"title":"Excel VBA期末报告：自动生成成绩表和分类统计","description":"本程序使用VBA自动生成Excel成绩表，根据课程数据进行成绩评定和等级划分，并将数据分类到不同学期的工作表中，方便学生统计和分析。","keywords":"Excel VBA, 期末报告, 成绩表, 分类统计, 自动生成, 课程数据","content":"以下是按照您的要求编写的VBA程序：\n\nvba\nSub CreateWorkbook()\n Dim studentName As String\n Dim folderPath As String\n Dim fileName As String\n Dim wb As Workbook\n Dim ws As Worksheet\n \n ' 获取学生姓名\n studentName = InputBox("请输入学生姓名：")\n \n ' 创建文件夹\n folderPath = "E:\" & studentName & " Excel VBA期末报告数据\"\n If Dir(folderPath, vbDirectory) = "" Then\n MkDir folderPath\n End If\n \n ' 创建工作簿\n fileName = studentName & "成绩表.xlsx"\n Set wb = Workbooks.Add\n wb.SaveAs folderPath & fileName\n \n ' 修改第一张工作表的标签名称为成绩表\n Set ws = wb.Sheets(1)\n ws.Name = "成绩表"\n \n ' 添加表头\n ws.Range("A1:F1").Value = Array("课程名称", "任课教师", "所在学期", "课程性质", "成绩", "等级")\n \n ' 录入课程数据\n Dim i As Long\n Dim lastRow As Long\n lastRow = 2 ' 从第二行开始录入数据\n For i = 1 To 10 ' 这里假设您需要录入10门课程数据，请根据实际情况调整\n ws.Cells(lastRow, 1).Value = "课程名称" & i ' 课程名称\n ws.Cells(lastRow, 2).Value = "任课教师" & i ' 任课教师\n ws.Cells(lastRow, 3).Value = "大一上学期" ' 所在学期\n ws.Cells(lastRow, 4).Value = "专业必修" ' 课程性质\n ws.Cells(lastRow, 5).Value = 80 + i ' 成绩\n lastRow = lastRow + 1\n Next i\n \n ' 进行成绩评定和标红\n Dim score As Long\n Dim grade As String\n For i = 2 To lastRow - 1\n score = ws.Cells(i, 5).Value\n If score >= 90 Then\n grade = "优秀"\n ElseIf score >= 80 Then\n grade = "良好"\n ElseIf score >= 70 Then\n grade = "中等"\n ElseIf score >= 60 Then\n grade = "合格"\n Else\n grade = "不合格"\n End If\n ws.Cells(i, 6).Value = grade\n If grade = "优秀" Then\n ws.Rows(i).Interior.ColorIndex = 3 ' 设置底纹颜色为红色\n End If\n Next i\n \n ' 创建三张工作表\n wb.Sheets.Add After:=wb.Sheets(wb.Sheets.Count)\n wb.Sheets.Add After:=wb.Sheets(wb.Sheets.Count)\n wb.Sheets.Add After:=wb.Sheets(wb.Sheets.Count)\n \n ' 修改工作表标签名称\n wb.Sheets(2).Name = "大一上学期"\n wb.Sheets(3).Name = "大一下学期"\n wb.Sheets(4).Name = "大二上学期"\n \n ' 将课程数据分类到相应的工作表中\n Dim semester As String\n For i = 2 To lastRow - 1\n semester = ws.Cells(i, 3).Value\n Select Case semester\n Case "大一上学期":\n ws.Rows(i).Copy Destination:=wb.Sheets("大一上学期").Range("A" & wb.Sheets("大一上学期").Cells(Rows.Count, 1).End(xlUp).Row + 1)\n Case "大一下学期":\n ws.Rows(i).Copy Destination:=wb.Sheets("大一下学期").Range("A" & wb.Sheets("大一下学期").Cells(Rows.Count, 1).End(xlUp).Row + 1)\n Case "大二上学期":\n ws.Rows(i).Copy Destination:=wb.Sheets("大二上学期").Range("A" & wb.Sheets("大二上学期").Cells(Rows.Count, 1).End(xlUp).Row + 1)\n End Select\n Next i\n \n ' 保存工作簿\n wb.Save\n \n ' 关闭工作簿\n wb.Close\n \n ' 清空对象引用\n Set ws = Nothing\n Set wb = Nothing\nEnd Sub\n\n\n请根据实际情况完成代码中的注释部分，以完善程序功能。