[已解决]如何用VBA设计班级成绩查询系统

jinzikun

各位大师，我手头有个年级成绩汇总表，想设计一个班级成绩查询系统，只要输入班级名，指定区域就会显示该班级的成绩表，具体代码不知如何写，请多多帮助或指教。

最佳答案

月排行榜 / 总排行榜

grf1973

2017-1-23 13:31

1. Sub 查询()
   
2.     Dim FindRng As Range
   
3.     bj = [c2] & "班"
   
4.     nj = Left(bj, 1)      '年级名
   
5.     sname = Mid("一二三四五六", nj, 1) & "年级汇总表"       '通过年级名确定工作表名
   
6.     [a4:m100].ClearContents
   
7.     With Sheets(sname)
   
8.         Set FindRng = .UsedRange.Find(bj)
   
9.         If FindRng Is Nothing Then
   
10.             MsgBox sname & "中查无此班": Exit Sub
    
11.         Else
    
12.             r1 = FindRng.Row
    
13.             r2 = .Cells(r1 + 1, 2).End(xlDown).Row
    
14.             .Cells(r1 + 1, 1).Resize(r2 - r1, 13).Copy Sheets(1).[a4]
    
15.         End If
    
16.     End With
    
17. End Sub
    

复制代码

跳转到最佳答案楼层

grf1973

1. Sub 查询()
   
2.     Dim FindRng As Range
   
3.     bj = [c2] & "班"
   
4.     [a4:m100].ClearContents
   
5.     With Sheets(2)
   
6.         Set FindRng = .UsedRange.Find(bj)
   
7.         If FindRng Is Nothing Then
   
8.             MsgBox "查无此班": Exit Sub
   
9.         Else
   
10.             r1 = FindRng.Row
    
11.             r2 = .Cells(r1 + 1, 2).End(xlDown).Row
    
12.             .Cells(r1 + 1, 1).Resize(r2 - r1, 13).Copy Sheets(1).[a4]
    
13.         End If
    
14.     End With
    
15. End Sub

复制代码

jinzikun

grf1973 发表于 2017-1-23 09:11

非常感谢大师的帮助，这么快有了答案，而且代码简洁，运行流畅。学生还想知道，如果我还有其他年级的成绩在不同的工作表里，怎么修改代码，请大师帮忙修改一下，万分感谢！

grf1973

1. Sub 查询()
   
2.     Dim FindRng As Range
   
3.     bj = [c2] & "班"
   
4.     nj = Left(bj, 1)      '年级名
   
5.     sname = Mid("一二三四五六", nj, 1) & "年级汇总表"       '通过年级名确定工作表名
   
6.     [a4:m100].ClearContents
   
7.     With Sheets(sname)
   
8.         Set FindRng = .UsedRange.Find(bj)
   
9.         If FindRng Is Nothing Then
   
10.             MsgBox sname & "中查无此班": Exit Sub
    
11.         Else
    
12.             r1 = FindRng.Row
    
13.             r2 = .Cells(r1 + 1, 2).End(xlDown).Row
    
14.             .Cells(r1 + 1, 1).Resize(r2 - r1, 13).Copy Sheets(1).[a4]
    
15.         End If
    
16.     End With
    
17. End Sub
    

复制代码

jinzikun

grf1973 发表于 2017-1-23 13:31

再次感谢grf1973大师，问题已解决，输入非法字符查询而出现的错误警告，我可以用数据的有效性加以提醒或限制，谢谢！！！