利用Excel VBA查找同名学生
时间：2005-03-05 12:34 来源：未知 作者：未知 阅读：次
1．问题的提出
每个学期都会出现同名同姓学生报到而发生一些张冠李戴的事情，给学校的一些管理带来了一定的麻烦。本人曾尝试使用Excel的既有功能解决这个问题，但都没有收到很好的效果，于是考虑使用VBA。
2．解决问题的目的
假设图1是学生的名单，然后从学生名单中提取出同名同姓学生的姓名及班别，复制到Sheet2中（图2），学校可以通过Sheet2的信息，辨别出共有多少同名同姓的学生及其所在的班级 。
3． 解决思路
使用CountIf()函数对学生姓名进行判断，如果CountIf()函数的值大于1，则表示该姓名有重复，然后将其复制到表Sheet2中。
4．解决问题的办法
点击“工具→宏→Visual Basic编辑器”，进入VBA开发环境，点击“插入→模块”，这时出现代码窗口，在其中输入下列代码：
Sub tmtx()
Sheets("sheet2").[a1] = "班别"
Sheets("sheet2").[b1] = "姓名"
a=sheets("sheet1").[a1].CurrentRegion.Rows.Count ‘判断学生名单的行数。
For i = 2 To a
k = Sheets("sheet2").[a1].CurrentRegion.Rows.Count + 1
If Application.WorksheetFunction.CountIf([c1:c65530], Cells(i, 3)) > 1 Then
Sheets("sheet2").Cells(k, 2) = Sheets("sheet1").Cells(I, 3)
Sheets("sheet2").Cells(k, 1) = Sheets("sheet1").Cells(I, 2)
End If
‘使用CountIf()函数对每个学生名字进行判断，如果CountIf()值大于1，则将其复制到Sheet2。
Next
Sheets("sheet2").[a1].CurrentRegion.Sort Key1:=Sheets("sheet2").[b1], Order1:=xlAscending, Header:=xlGuess
‘对复制到Sheet2的内容以“姓名”作为关键字排序，从而实现同名同姓学生的姓名排在一起，以方便查阅。
If Sheets("sheet2").[a2] = "" Then
MsgBox“无同名同姓学生！”，“报告”
End If
‘如果没有同名同姓的学生，则跳出报告信息窗口。
Sheets("sheet2").Select
End sub
为了便于以后每个学期都能使用该程序，我们可这样做：点击“文件/导出”，将其保存为.bas文件，要使用时，点击“文件/导入”就可以了。
每个学期都会出现同名同姓学生报到而发生一些张冠李戴的事情，给学校的一些管理带来了一定的麻烦。本人曾尝试使用Excel的既有功能解决这个问题，但都没有收到很好的效果，于是考虑使用VBA。
2．解决问题的目的
假设图1是学生的名单，然后从学生名单中提取出同名同姓学生的姓名及班别，复制到Sheet2中（图2），学校可以通过Sheet2的信息，辨别出共有多少同名同姓的学生及其所在的班级 。
3． 解决思路
使用CountIf()函数对学生姓名进行判断，如果CountIf()函数的值大于1，则表示该姓名有重复，然后将其复制到表Sheet2中。
4．解决问题的办法
点击“工具→宏→Visual Basic编辑器”，进入VBA开发环境，点击“插入→模块”，这时出现代码窗口，在其中输入下列代码：
Sub tmtx()
Sheets("sheet2").[a1] = "班别"
Sheets("sheet2").[b1] = "姓名"
a=sheets("sheet1").[a1].CurrentRegion.Rows.Count ‘判断学生名单的行数。
For i = 2 To a
k = Sheets("sheet2").[a1].CurrentRegion.Rows.Count + 1
If Application.WorksheetFunction.CountIf([c1:c65530], Cells(i, 3)) > 1 Then
Sheets("sheet2").Cells(k, 2) = Sheets("sheet1").Cells(I, 3)
Sheets("sheet2").Cells(k, 1) = Sheets("sheet1").Cells(I, 2)
End If
‘使用CountIf()函数对每个学生名字进行判断，如果CountIf()值大于1，则将其复制到Sheet2。
Next
Sheets("sheet2").[a1].CurrentRegion.Sort Key1:=Sheets("sheet2").[b1], Order1:=xlAscending, Header:=xlGuess
‘对复制到Sheet2的内容以“姓名”作为关键字排序，从而实现同名同姓学生的姓名排在一起，以方便查阅。
If Sheets("sheet2").[a2] = "" Then
MsgBox“无同名同姓学生！”，“报告”
End If
‘如果没有同名同姓的学生，则跳出报告信息窗口。
Sheets("sheet2").Select
End sub
为了便于以后每个学期都能使用该程序，我们可这样做：点击“文件/导出”，将其保存为.bas文件，要使用时，点击“文件/导入”就可以了。
(责任编辑：admin)
顶一下
(0)
0%
踩一下
(0)
0%
最新内容
推荐内容