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

奕克

爱家人爱工作爱生活

 
 
 

日志

 
 

excel的经典数据格式转换VBA  

2014-06-09 21:00:08|  分类: office |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |
       一个活生生的例子,几年前我要查看一下自己班的考勤记录 哦,问学办要过来的考勤表是这个格式的,一看我就傻眼了,我记性不好,每个表需要看一下我做班主任班的记录,但是看到后面几周后,前几周的数据给忘了。。。于是写了个VBA,从10几个表挑出了自己班的记录,做成一个表,然后上office编程课时就做为例子跟学生讲。。。
excel的经典数据格式转换VBA - wucccsk - 奕克
这次讲课时顺道把它改的通用点,可以遍历一个excel文件的所有表,找出每个表中第一列相同的那些记录,各自生成独立的表,如下图。。。感觉自己每年vba技术还是有进步的,虽然除了上课已经基本不写了。。。学程序真的要多写代码,最近学python,发现懒得上机码程序,学习效果差多了,要不也开门公选课?。。。
excel的经典数据格式转换VBA - wucccsk - 奕克
 程序源代码如下,运行这个宏,开头输入每个表的标题占几行就可以了,比如这个例子输入2。。
Sub a()
r = InputBox("输入表标题所占行数")
Set wk = Workbooks.Add
For i = 1 To ThisWorkbook.Worksheets.Count
 j = r + 1
 Do While ThisWorkbook.Worksheets(i).Cells(j, 1).Value <> ""
 Find = False
 For k = 1 To wk.Worksheets.Count
   If ThisWorkbook.Worksheets(i).Cells(j, 1).Value = wk.Worksheets(k).Name Then
     Find = True: Exit For
   End If
 Next
 If Find = False Then
    Set ws = wk.Worksheets.Add
    ws.Name = ThisWorkbook.Worksheets(i).Cells(j, 1).Value
    ThisWorkbook.Worksheets(2).Rows("1:" & r).Copy
    ws.Rows("1:" & r).PasteSpecial
 End If
 na = ThisWorkbook.Worksheets(i).Cells(j, 1).Value
 ThisWorkbook.Worksheets(i).Rows(j).Copy
 k = wk.Worksheets(na).UsedRange.Rows.Count + 1
 wk.Worksheets(na).Rows(k).PasteSpecial
 j = j + 1
 Loop
Next
Set ws = Nothing
Set wk = Nothing
End Sub

  评论这张
 
阅读(108)| 评论(0)
推荐 转载

历史上的今天

在LOFTER的更多文章

评论

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

页脚

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