Board logo

标题: 利用Excel VBA查找同名学生 [打印本页]

作者: 月上西楼    时间: 2007-8-25 12:26     标题: 利用Excel VBA查找同名学生

  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文件,要使用时,点击“文件/导入”就可以了
作者: zhang1987    时间: 2007-8-27 14:10     标题: 嘻嘻

这个是什么呀。
还用代码。




欢迎光临 编程开发论坛 (http://bbs.lihuasoft.net/) Powered by Discuz! 6.0.0