VBA之Excel应用第三章第六节:批量导入工作表到同一个文件

360影视 2025-02-06 17:49 3

摘要:《VBA之Excel应用》(版权10178983)是非常经典的,是我推出的第七套教程,定位于初级,目前是第一版修订。这套教程从简单的录制宏开始讲解,一直到窗体的搭建,内容丰富,实例众多。大家可以非常容易的掌握相关的知识,这套教程共三册,十七章,都是我们在利用E

《VBA之Excel应用》(版权10178983)是非常经典的,是我推出的第七套教程,定位于初级,目前是第一版修订。这套教程从简单的录制宏开始讲解,一直到窗体的搭建,内容丰富,实例众多。大家可以非常容易的掌握相关的知识,这套教程共三册,十七章,都是我们在利用EXCEL工作过程中需要掌握的知识点,希望大家能掌握利用。今日讲解的内容是:VBA之Excel应用第三章第六节:批量导入工作表到同一个文件

【分享成果,随喜正能量】有些人受恩惠久了,容易从最初的感激,变成理所当然,而偶尔的相助,反而会让他记得一辈子。。

大家好,我们在上节讲解了如何提取一个文件夹下面的文件名及每个文件的工作表的名称到工作表中,这讲我们将讲解如何把一个文件夹下的所有文件的工作表导入到同一个文件中,这讲的知识点有:工作表的整体导入方法,以及如何关闭例外提示的信息。

我们在实际工作中,经常会用到把多个文件的工作表批量复制到同一个文件中,如下,在当前路径的文件夹“导入文件”中有若干个文件:

我们的目的是将每个文件中的工作表逐一复制到同一个文件中,形成一个文件。这讲我们将讲解这个问题的代码实现过程。

为了实现批量导入工作表,我们仍是利用文件夹中文件的遍历及每一个文件中工作表的遍历,在实现遍历的时候要进行的是工作表的复制,然后粘贴到同一个文件中。对于复制和粘贴工作表我们要利用的是工作表复制语句。

对于工作表的复制和粘贴,有时会有异常信息的提示,这是我们所不期望的,这就要屏蔽这些信息。也是利用VBA代码来完成这项工作。

将工作表复制到当前工作簿或新工作簿中的其他位置,我们可以用Worksheet.Copy 方法

1)语法:expression.Copy (Before, After)

2)参数:

① Before 可选 Variant类型 将要在其之前放置所复制工作表的工作表。如果指定After, 则不能指定Before。

② After 可选 Variant类型 将要在其之后放置所复制工作表的工作表。 如果指定了 Before,则不能指定 After。

3)使用说明:如果不指定Before或After, Microsoft Excel 将新建一个工作簿, 其中包含复制的工作表对象。新创建的工作簿包含ActiveWorkbook属性, 并且包含一个工作表。 单个工作表保留源工作表的Name 和CodeName 属性。如果复制的工作表在VBA 项目中包含一个工作表代码工作表, 则该工作表也会进入新工作簿中。

4 屏幕刷新(ScreenUpdating)及例外信息提示(DisplayAlerts)

1) Application.ScreenUpdating 属性 如果屏幕更新已启用,此属性的值为 True。

语法:expression.ScreenUpdating

参数:expression 表示 Application 对象的变量。

禁用屏幕更新可以加快宏代码的速度。虽然无法实时了解宏的最新动态,但它的运行速度会变快。当宏结束运行后,请记住将 ScreenUpdating 属性设置回 True。

2)Application.DisplayAlerts 属性 如果宏运行时 Microsoft Excel 显示特定的警告和消息,则为 True。

语法: expression.DisplayAlerts

参数:expression表示 Application 对象的变量。

expression.DisplayAlerts默认值为 True。 将此属性设置为 False 可在宏运行时禁止显示提示和警告消息;当出现需要用户应答的消息时,Microsoft Excel 将选择默认应答。如果将此属性设置为False,要在代码完成时将此属性重设为True。

为了实现工作表的批量导入,我先给出下面的代码,然后再进行讲解:

Sub mynzK '导入工作表

Dim directory As String, myfileName As String, mysheet As Worksheet

Application.ScreenUpdating = False

Application.DisplayAlerts = False

directory = ThisWorkbook.Path & "\导入文件\"

myfileName = Dir(directory & "*.xl??") '使用Dir函数来查找存储在此目录中的第一个*.xl??文件

Do While myfileName ""

Workbooks.Open (directory & myfileName)

For Each mysheet In Workbooks(myfileName).Worksheets

total = ThisWorkbook.Worksheets.Count

Workbooks(myfileName).Worksheets(mysheet.Name).Copy _

after:=ThisWorkbook.Worksheets(total)

Next

Workbooks(myfileName).Close '关闭Excel文件

myfileName = Dir '获取其他Excel文件,再次使用Dir函数而不带参数

Loop

Application.ScreenUpdating = True

Application.DisplayAlerts = True

End Sub

代码截图:

代码讲解:

1) Application.ScreenUpdating = False

Application.DisplayAlerts = False

以上代码将关闭屏幕更新及例外信息提示,在程序结束后,要打开这个设置,值为true。

2) total = ThisWorkbook.Worksheets.Count

变量total跟踪导入的工作表的工作表数,我们最后将使用Worksheet对象的Copy方法复制每个工作表并将其粘贴到ThisWorkbook最后一个工作表之后。

3)Workbooks(myfileName).Worksheets(mysheet.Name).Copy _

after:=ThisWorkbook.Worksheets(total)

以上代码将复制myfileName工作簿中的每个工作表,然后粘贴到当前工作簿的最后位置。

代码运行效果:

从上图中可以看出,文件夹中所有文件的工作表都拷贝到了当前的工作簿中了。

今日内容回向:

1) 如何关闭屏幕刷新及例外信息提示?

2) 如何导入整个工作表到当前工作簿?

3) 遍历循环应用在这讲有什么作用?

本讲内容参考程序文件:工作簿03.xlsm

我20多年的VBA成果全在下面的资料中:

来源:VBA语言专业教育

相关推荐