怎样使用VBA多表成绩搜索?

1、首先在开发工具中打开VBA编辑器

2、在单元格区域当中输入一些内容作为例子

3、在VBA编辑器中插入模块

4、在模块当中输入如下代码，然后运行

Sub 成绩搜索()

 

Dim t, arr(), intRows As Integer

 

    t=Timer  '初始化时间变量

 

    Application.ScreenUpdating=False

 

    On Error Resume Next

 

    Range("c2:h1048576").Clear  '清除上次查询信息

 

    查找值=Cells(2, 1)       '设定查找目标为A2的值

 

    For i=2 To Sheets.Count   '遍历工作表（第一个表即当前表除外）

 

      Set c=Sheets(i).Range("a2:a100").Find(what:=查找值)

 

                      'A2∶A100可以是自己根据实际状况定义区域大小

 

      If Not c Is Nothing Then

 

          firstAddress=c.Address

 

          Do

 

              intRows=intRows+1 '累加计数器

 

              ReDim Preserve arr(1 To 6, 1 To intRows)  '重定义数组变量

 

              arr(1, intRows)=Sheets(i).Name

 

                              '数组第一子项目赋值为查找到的数据所在工作表名

 

              arr(2, intRows)=c.Address

 

                              '数组第二子项目赋值为查找到的数据所在单元格地址

 

              arr(3, intRows)=c.Value

 

                          '数组第三子项目赋值为查找到的数据

 

            arr(4, intRows)=c.Offset(0, 1).Text

 

                        '数组第四子项目赋值为查找到的数据右移一个单元格的值

 

            arr(5, intRows)=c.Offset(0, 2).Text

 

                        '数组第五子项目赋值为查找到的数据右移二个单元格的值

 

            arr(6, intRows)=c.Offset(0, 3).Text

 

                        '数组第六子项目赋值为查找到的数据右移三个单元格的值

 

            Set c=Sheets(i).Range("a2:a100").FindNext(c)

 

          Loop While Not c Is Nothing And c.Address <> firstAddress

 

      End If

 

  Next

 

  Range("C2:h" & intRows)=Application.Transpose(arr)

 

                              '将找到的值赋予单元格区域

 

  Range("C2:h" & intRows).Borders.LineStyle=xlContinuous  '添加边框

Application.ScreenUpdating=True

 

  MsgBox Format(Timer-t, "0.00") & "秒"  '提示总运行时间

 

End Sub

5、在单元格A2输入“刘”并回车，右边出现所有姓“刘”的学生的姓名、班级、学号和成绩