Excel:使用宏复制另一个Excel表格里的文件

本文为原创,转载请注明出处和作者。
临近毕业,事情也变得多起来,好多是填这个表格填那个表格的,对普通的学生来说,填完表发给班长就好了,但对班长来说,还有一个叫做“明细表”或“汇总表”的Excel表格需要填写,当数据量比较大,枯燥无味的复制粘贴让人心烦啊,这不,辅助学分的明细表来了。

需求:

有27个Excel文件,每个文件的里信息格式都是如下形式:

 项目1 | 学分 | 项目2 | 学分 | 项目3 | 学分 …

第一学期

第二学期

第三学期

第四学期

…(共8个学期)

另外,还有一个明细文件,里面的信息格式如下所示:

姓名 | 项目1 | 学分 | 项目2 | 学分 | 项目3 | 学分 …

一共有8个Sheet,代表8个学期,每个Sheet的信息格式都像上面一样。

现在的任务是将27个Excel文件的信息按照姓名和学期复制到明细文件中对应的单元格中。如果枯燥的复制粘贴,简直要疯了!那么,如何简化呢?答案是:宏。

———————————–我是华丽的分割线————————————

下面讲一下如何用“宏”来简化我们的工作。

Step 1:在Excel中启用宏

为了安全,默认情况下,Office软件是关闭宏的,这是为了安全起见。(为什么呢?有人可以给你发一个带有恶意宏的word文件,如果你启用了宏并打开了这个word文件,那么这个恶意宏就有可能绑架你的电脑,可以查看你电脑的所有文件,还能在你毫不知情的情况下打开摄像头录视频哦,这里的毫不知情是打开摄像头而不让摄像头发光,正常情况下笔记本的摄像头在打开的情况下是发光的,不信你试试看发不发光。既然这么危险,我们干嘛还要用宏呢?我们自己编写的宏又不是让它干坏事,完成工作之后再禁用宏不就得了。

启用宏的方法:点我查看Office 2007启用宏的方法点我查看Office 2010启用宏的方法(从第5步开始看)点我查看Office 2013启用宏的方法

Step 2: 编写宏文件

启用宏之后,在工具栏会出现新的选项卡“开发工具”,在“开发工具”选项卡下,左边第二个有个“宏”,点击它可插入宏。

在宏文件的编辑器中粘贴一下代码:

'下面是全局变量
Public excelPath As String 
Public myInt As Integer   '公共
Public myName As String   '公共
Public toRow As Integer   '用以标注源文件中行的变量
Public fromRow As Integer '用以标注目的文件中行的变量
'以上是全局变量


Sub insert()     '这个是函数名,在插入宏时设置的函数名,可以改
   '下面定义的变量中有一些没有用到,就不要纠结了
   Dim myPath$, myFile$, AK As Workbook, aRow%, tRow%, i As Integer
   toRow = 5       '在目的文件中的第几行插入数据(实际上是在第6行插入,
                   '但下面代码中有toRow = toRow +1)
   Application.ScreenUpdating = False        '冻结屏幕,以防屏幕抖动
   myPath = ThisWorkbook.Path          '把文件夹路径定义给变量
   'MsgBox myPath    '把这行前面的单引号去掉,然后运行程序可以看看文件夹的路径对不对
   myFile = Dir(myPath & "\*.xls")   '依次找寻指定路径中的*.xls文件,要保证本文件夹下没有其他无用的文件
   'MsgBox myFile
   Do While myFile <> ""              '当指定路径中有文件时进行循环
      toRow = toRow + 1
      If myFile <> ThisWorkbook.Name Then  '不包括目的文件
          Set AK = Workbooks.Open(myPath & "\" & myFile)        '打开符合要求的文件
          tempRow = 5
          For i = 1 To 8 '一共8个学期
            fromRow = tempRow + i  '计算当前该处理第几个学期
            AK.Sheets(1).Range("c" & fromRow & ":o" & fromRow).Copy ThisWorkbook.Sheets(i).Range("c" & toRow & ":o" & toRow)
         Next
         Workbooks(myFile).Close False               '关闭源工作簿,并不作修改
      End If
      myFile = Dir                                   '找寻下一个*.xls文件
   Loop
   Application.ScreenUpdating = True                 '冻结屏幕,此类语句一般成对使用
End Sub

这样,运行上面这个程序,一会儿就可以完成任务喽~

 

发表评论

电子邮件地址不会被公开。 必填项已用*标注

3 × 3 =

70 − 68 =