注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

奕克

爱家人爱工作爱生活

 
 
 

日志

 
 

根据excel名单自动找谁没交文件-升级版  

2013-05-12 13:33:20|  分类: office |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |
        昨天监考计算机等级考试,在学生上传完试卷电子版之后,发现又开始了无聊的根据excel名单,校对哪个学生漏交数据包的工作,一大串的学号看得我眼花。想想自己以前的那个自动找谁没交材料的程序还有点缺陷,不适合于这种情况,今天抽点时间改了一下,改进功能包括:
        1.支持excel名单中的筛选功能,可以只查筛选后的那些显示行数据记录有没有上交文件
        2. 默认是第一个工作表第一列为上交文件名要包含的值,如果不一样,用文本方式打开源程序,如下的第一行的wkindex表示工作表号,columnindex表示列号,修改其值即可。
        3.程序将在筛选名单上但没有交文件的数据记录整行加红,如果有文件不在这个名单上,移动到生成的“找不到”文件夹下。 
        注意程序运行时,要把excel名单,vbs脚本程序和那些上交数据包放在一个同一个目录下,程序运行时,在弹出的对话框中输入excel名单的文件名(默认为名单.xls,可以在源程序第3行修改)。 

          vbs源文件下载在:http://www.kuaipan.cn/file/id_21545415677601841.htm

程序源代码:

wkindex=1
columnindex=1
wkname=inputbox("输入处理的excel文件名",,"名单")
wkfullname=wkname & ".xls"
strpath=left(wscript.scriptfullname,len(wscript.scriptfullname)-len(wscript.scriptname))
set xlapp= CreateObject("Excel.application")
Set md = xlapp.Workbooks.Open(strpath & wkfullname)
count=0
for j=1 to md.Worksheets(wkindex).usedrange.rows.count
  if md.Worksheets(wkindex).rows(j).hidden=false then
    redim preserve filtername(count+1)
    redim preserve filternameindex(count+1)
    filtername(count)=md.Worksheets(wkindex).cells(j,columnindex).value
    filternameindex(count)=j
    count=count+1
  end if
next
Set fso = CreateObject("Scripting.filesystemobject")
Set myFolder = fso.GetFolder(strpath)
Set myfiles = myFolder.Files
For Each myfile In myfiles
    if  myfile.Name<>wscript.scriptname and myfile.name<>wkfullname then 
    find=false
    for j=0 to ubound(filtername)
      If InStr(myfile.name,filtername(j)) Then
         find=true
         filternameindex(j)=0
         exit for
      end if
    next
    if not find then
       If Not fso.FolderExists(strpath & "\找不到") Then
            fso.CreateFolder strpath & "找不到"
       End If
       fso.movefile strpath & myfile.name,strpath & "\找不到\"&myfile.name
    end If
    End if
next
for j=0 to ubound(filternameindex) 
 if filternameindex(j)<>0 then    
  md.Worksheets(wkindex).rows(filternameindex(j)).font.color=RGB(255,0,0)
 end if
next  
md.save
md.close
set md=nothing
set xlapp=nothing
Set myFolder = Nothing
Set myfiles = Nothing
set fso=nothing
msgbox "完工!"
  评论这张
 
阅读(104)| 评论(0)
推荐 转载

历史上的今天

在LOFTER的更多文章

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2017