ExcelVBA_047 跨多文件查成绩

一、需求说明

每学期考试结束后，需要把每个班的期中、期末两次考试成绩分别保存到一个Excel工作簿的两个工作表中，格式如图：

其中工作表名用于区分期中和期末、A3单元格保留年级和班级，第10行开始保存成绩信息。

现为了方便查询学生的成绩，或者跟踪学生历来各学期成绩，制作了一个查询表，其中B2单元格用于指示姓名所在列，B3用于提供查询的学生姓名，希望能够查询到同一文件夹下所有学期、所有考试的各科记录。

二、实现思路

1、结合do while loop循环 与dir()函数依次遍历文件

2、打开文件，按照查询的要求，遍历每个打开工作簿的所有工作表、遍历工作表指定列的所有数据行，把符合要求的输出到查询表。

三、实现步骤

1、声明变量、实例化对象

2、结合do while loop 与dir()函数遍历同一文件夹下所有文件

3、逐个打开工作簿，遍历每一个工作表

4、预先清空查询表的结果区域，保存查询单列名、姓名信息

5、设定输出结果的行号，开始逐行遍历成绩源表的每一行，如果与查询条件一致，输出结果的行号下移一行

6、输出查询结果：A列考试场次、B列输出年级和班级、C列输出姓名，并以此类推

7、释放对象变量，画个按钮，运行测试一下

四、实现代码

Public Sub Basic_CodeFrame() '作者 DG-NextSeven 'QQ 84857038 '日期 2021年01月27日 '说明
Dim Wb As Workbook Dim OpenWb As Workbook Dim Sht As Worksheet Dim oSht As Worksheet Dim qName As String Dim qCol As String Set Wb = Application.ThisWorkbook Set Sht = Wb.Worksheets(1) Sht.UsedRange.Offset(7).ClearContents qName = Sht.Range('B3').Value qCol = Sht.Range('B2').Value Dim FolderPath, FileName, FilePath, FilePaths
FolderPath = Wb.Path & '\' FileName = Dir(FolderPath & '*.*') irow = 7 Do While FileName <> '' FilePath = FolderPath & FileName If FilePath <> Wb.FullName Then Set OpenWb = Application.Workbooks.Open(FilePath) For Each oSht In OpenWb.Worksheets With oSht endrow = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row For i = 2 To endrow If .Cells(i, qCol).Value = qName Then irow = irow + 1 Sht.Cells(irow, 1).Value = .Name Sht.Cells(irow, 2).Value = .Range('A3').Value Sht.Cells(irow, 3).Value = qName End If Next i End With
Next oSht OpenWb.Close False End If FileName = Dir Loop Set Wb = Nothing Set OpenWb = Nothing Set Sht = Nothing Set oSht = Nothing

End Sub


五、您快打赏打赏我吧！要不您就来一份小格子插件？