MSCBSC 移动通信论坛
搜索
登录注册
网络优化工程师招聘专栏 4G/LTE通信工程师最新职位列表 通信实习生/应届生招聘职位
 

  • 阅读:4216
  • 回复:1
【例子】第三讲 Excel对象综合应用例子
郑东文
初级会员
鎵嬫満鍙风爜宸查獙璇


 发短消息    关注Ta 

积分 140
帖子 27
威望 5181 个
礼品券 0 个
专家指数 5
注册 2019-1-2
专业方向 
回答问题数 0
回答被采纳数 0
回答采纳率 0%
 
发表于 2019-12-14 17:02:57  只看楼主 

已知某年段学生期末成绩表如图,现需写一个可按学号查询学生成绩的宏,要求如下:

1)支持一次查询多个学号记录

2)反馈查询结果,结果分查到和未查到两种情况3)为每条查询到的成绩记录单独创建一个WorkBook来保存并按学号加日期命名文件,保存成绩的工作表按学号命名。

image.png

image.png

'源代码

第三讲 例子.rar

'按学号批量查询成绩

Sub SearchScoreBySn()

Dim intR As Integer '行号

Dim intC As Integer '列号

Dim Col_SearchSn As New Collection '查询学号集合

Dim intColIndex As Integer '集合下标

Dim Dic_Score   As Object '成绩字典

Dim strSerRes As String '查询结果

Dim Wb_SerRec As Workbook '保存查询记录工作簿

Dim Ws_SerRec As Worksheet '保存查询记录工作表

Dim strFileName As String '保存文件名

'>>>读取查询学号>>>

intR = 2

Do While (Sheet2.Cells(intR, 1) <> "") '判断是否读到最后一行

    Col_SearchSn.Add Sheet2.Cells(intR, 1) '添加到查询学号集合

    intR = intR + 1

Loop

'<<<读取查询学号


'>>>创建成绩字典>>>

intR = 2

Set Dic_Score = CreateObject("scripting.dictionary")

Do While (Sheet1.Cells(intR, 1) <> "") '判断是否读到最后一行

    Dic_Score.Add CStr(Sheet1.Cells(intR, 1)), intR '以学号为关键字,学号所在行为值

    intR = intR + 1

Loop

'<<<创建成绩字典<<<


'>>>查询成绩并输出>>>

For intColIndex = 1 To Col_SearchSn.Count

    If Dic_Score.exists(CStr(Col_SearchSn(intColIndex))) Then '查询指定学号的成绩是否存在

       strSerRes = "查到"

       Set Wb_SerRec = Workbooks.Add ' wb_serrec指向新创建工作簿

       Set Ws_SerRec = Wb_SerRec.Sheets(1) 'ws_serrec指向wb_serrec第一个工作表

       Ws_SerRec.Name = CStr(Col_SearchSn(intColIndex)) '工作表名称命名为学号

       intC = 1

       intR = Dic_Score(CStr(Col_SearchSn(intColIndex)))

       Do While (Sheet1.Cells(1, intC) <> "")

          Ws_SerRec.Cells(1, intC) = Sheet1.Cells(1, intC) '把成绩表的标题字段赋值到ws_serrec第一行

          Ws_SerRec.Cells(2, intC) = Sheet1.Cells(intR, intC) '把成绩表的数据赋值到ws_serrec第二行

          intC = intC + 1

       Loop

       strFileName = "D:" & CStr(Col_SearchSn(intColIndex)) & "_" & Date & ".xlsx"

       Wb_SerRec.SaveAs strFileName

       Wb_SerRec.Close

    Else

       strSerRes = "未查到"

    End If

    Sheet2.Cells(intColIndex + 1, 2) = strSerRes '反馈查询结果

Next intColIndex

'<<<查询成绩并输出<<<

End Sub



查看积分策略说明
附件下载列表:
2019-12-14 17:02:40  下载次数: 43
第三讲 例子.rar (26.31 KB)
微信扫描分享本文到朋友圈
微信扫描二维码,手机阅读更便捷
每天分享朋友圈可获得威望奖励(前两次)

对本帖内容的看法? 我要点评

 
[充值威望,立即自动到帐] [VIP贵宾权限+威望套餐] 另有大量优惠赠送活动,请光临充值中心
充值拥有大量的威望和最高的下载权限,下载站内资料无忧
hyhy
银牌会员
鎵嬫満鍙风爜宸查獙璇


 发短消息    关注Ta 

纪念勋章·七周年  
积分 2960
帖子 574
威望 -3042 个
礼品券 8 个
专家指数 90
注册 2010-6-6
专业方向  无线网优
回答问题数 70
回答被采纳数 3
回答采纳率 4%
 
发表于 2019-12-30 17:46:13 


QUOTE:
原帖由 wx_10259334 于 2019-12-14 17:02:57 发表
已知某年段学生期末成绩表如图,现需写一个可按学号查询学生成绩的宏,要求如下:1)支持一次查询多个学号记录2)反馈查询结果,结果分查到和未查到两种情况3)为每条查询到的成绩记录单独创建一个WorkBook来保 ...

谢谢楼主分享

对本帖内容的看法? 我要点评

 
[立即成为VIP会员,百万通信专业资料立即下载,支付宝、微信付款,简单、快速!]

快速回复主题    
标题
内容
 上传资料请点左侧【添加附件】



当前时区 GMT+8, 现在时间是 2020-1-18 08:22:39
渝ICP备11001752号  Copyright @ 2006-2016 mscbsc.com  本站统一服务邮箱:mscbsc@163.com

Processed in 0.817274 second(s), 17 queries , Gzip enabled
TOP
清除 Cookies - 联系我们 - 移动通信网 - 移动通信论坛 - 通信招聘网 - Archiver