今天再分享下汇总指定文件夹下每个工作簿中工作表名称包含某个指定关键词的小代码（当不指定关键词时，则默认汇总所有工作表数据）。

举个栗子。假设有一文件夹，内有十几个工作簿，每个工作簿又各有多个不等数量的工作表，现在我们只想汇总每个工作簿中工作表名称包含“看见星光”的数据，那就可以使用我们今天分享的小代码了。

如果是想把所有工作表的数据一股脑全部汇总呢？不管它什么“看见星光”还是“看见月光”的——也可以使用今天的代码，程序运行中弹出的输入关键词对话框什么都不填直接确定就可以了。

小贴士：

1、（重复说明）如果需要汇总所有工作表的数据，关键词对话框什么都不填直接确定就可以了、另外关键词不区分字母大小写。

2、如果需要汇总的工作表含有多个不同的关键词……也是可以的，由于代码汇总后的数据后增加一个“来源工作表”的字段，表亲们可以先把所有工作表的数据汇总，然后根据“来源工作表”字段对数据明细进行筛选删除操作。

代码如下：

Sub Collectwks()

Dim Sht As Worksheet, rng As Range, Sh As Worksheet

Dim Trow&, k&, arr, brr, i&, j&, book&, a&

Dim p$, f$, Headr, Keystr

'

With Application.FileDialog(msoFileDialogFolderPicker)

'取得用户选择的文件夹路径

.AllowMultiSelect = False

If .Show Then p = .SelectedItems(1) Else Exit Sub

End With

If Right(p, 1) <> "\" Then p = p & "\"

'

Keystr = InputBox("请输入需要合并的工作表所包含的关键词：", "提醒")

If StrPtr(Keystr) = 0 Then Exit Sub

'如果点击了inputbox的取消或者关闭按钮，则退出程序

Trow = Val(InputBox("请输入标题的行数", "提醒"))

If Trow < 0 Then MsgBox "标题行数不能为负数。", 64, "警告": Exit Sub

Set Sht = ActiveSheet

Application.ScreenUpdating = False '关闭屏幕更新

Cells.ClearContents

Cells.NumberFormat = "@"

'清空当前表数据并设置为文本格式

ReDim brr(1 To 200000, 1 To 2)

'定义装汇总结果的数组brr，最大行数为20万行，2列是临时的

'

f = Dir(p & "*.xls*") '开始遍历工作簿

Do While f <>""

If f <> ThisWorkbook.Name Then '避免同名文件重复打开出错

With GetObject(p & f)

'以'只读'形式读取文件时，使用getobject方法会比workbooks.open稍快

For Each Sh In .Worksheets '遍历表

If InStr(1, Sh.Name, Keystr, vbTextCompare) Then

'如果表中包含关键词则进行汇总(不区分关键词字母大小写）

Set rng = Sh.UsedRange

If rng.Count > 1 Then

'如果rng的单元格数量大于1……

book = book + 1 '标记一下是否首个Sheet,如果首个sheet，BOOK=1

a = IIf(book = 1, 1, Trow + 1) '遍历读取arr数组时是否扣掉标题行

arr = rng.Value '数据区域读入数组arr

If UBound(arr, 2) + 2 > UBound(brr, 2) Then

'动态调整结果数组brr的最大列数，避免明细表列数不一的情况。

ReDim Preserve brr(1 To 200000, 1 To UBound(arr, 2) + 2)

End If

For i = a To UBound(arr) '遍历行

k = k + 1 '累加记录条数

brr(k, 1) = f '数组第一列放工作簿名称

brr(k, 2) = Sh.Name '数组第二列放工作表名称

For j = 1 To UBound(arr, 2) '遍历列

brr(k, j + 2) = arr(i, j)

Next

Next

End If

End If

Next

.Close False '关闭工作簿

End With

End If

f = Dir '下一个表格

Loop

If k > 0 Then

Sht.Select

[a1].Offset(IIf(Trow = 0, 1, 0)).Resize(k, UBound(brr, 2)) = brr '放数据区域

[a1].Resize(1, 2) = [{"来源工作簿名称","来源工作表名"}]

MsgBox "汇总完成。"

End If

Application.ScreenUpdating = True '恢复屏幕更新

End Sub

本篇文章讲的是Excel文件的读写和处理。Excel除了是普通生活中应用广泛的数据处理软件和数据保存格式外，在商业分析中也占有非常大的重量，熟练使用Excel软件是数据分析师很关键的技能点，但这篇笔记不是讲各类Excel函数和快捷键，而是讲Python对Excel的 .xls 和 .xlsx 格式数据的读写和处理。

目录

Excel文件简介Excel文件的读取Excel文件的写入pandas库读写Excel筛选与统计量计算

Excel文件简介

Excel其实相信大家都不陌生，一个 .xls（Excel 2013后默认格式为 .xlsx ）文件是一个工作簿（workbook），包含多个表（worksheet），每个表内数据按照行列进行组织，书中第三章的用词中，“文件”和“工作簿”表示同一个对象。拿本篇笔记用到的示例文件

sales_2015.xlsx 为例：

本篇笔记需要用到两个库： xlrd 和 xlwt，这两个库不是内置模块，但安装了Anaconda集成环境的话，这两个库被包含了，可以通过 import xlrd 和 import xlwt 进行测试，如果提示未安装，可以通过命令行下用pip安装，本处不展开。xlrd用来读取Excel文件，xlwt用于构建Workbook对象进行Excel文件的创建和写入数据。这两个库不能对Excel文件进行直接更改，因此思路是

复制一份数据到内存进行分析计算，再写入新Excel文件中

。需要直接性地修改可以考虑VBA吧，VBA（Visual Basic for Applications）是目前 Office 套件支持的基于 Visual Basic 的宏语言，目前一般在Excel或PPT内进行编程实现高级效果（如Excel数据的批量修改）一般都用VBA，当然以后Office要内置Python了，现在学好Python以后就能很容易理解和定制化Excel的宏了。

Excel文件的读取

通过xlrd库的open_workbook()对Excel数据进行读入。

#lrd读取并输出基本信息# -*- coding: utf-8 -*-def readExcel(fname):from xlrd import open_workbook workbook = open_workbook(fname) print('工作表数量:', workbook.nsheets) for worksheet in workbook.sheets(): #循环输出表名 print("Worksheet name:", worksheet.name, "\tRows:",worksheet.nrows, "\tColumns:", worksheet.ncols)readExcel('sales_2015.xlsx')

输出:

工作表数量: 3Worksheet name: january_2015 Rows: 7 Columns: 5Worksheet name: february_2015 Rows: 7 Columns: 5Worksheet name: march_2015 Rows: 7 Columns: 5

Excel文件的写入

写入要用到 xlwt 库，如下面的代码，创建一个Workbook对象后，通过worksheet.write()写入数据。因为使用with进行处理，所以不需要写close()显式关闭打开的文件。

#读取一些Excel并写入新表def parsingExcToWrite(in_file,out_file):from xlrd import open_workbook from xlwt import Workbook #导入一个 Workbook对象 output_workbook = Workbook() output_worksheet = output_workbook.add_sheet('jan_2015_output') #加一个新工作表到工作簿对象里 with open_workbook(in_file) as workbook: worksheet = workbook.sheet_by_name('january_2015') #引用上面创建的工作表 print('type(worksheet):',type(worksheet)) print('write()传入参数类型:',type(worksheet.cell_value)) for row_index in range(worksheet.nrows): for column_index in range(worksheet.ncols): #枚举写入数据 output_worksheet.write(row_index, column_index, worksheet.cell_value(row_index, column_index)) output_workbook.save(out_file)in_f='sales_2015.xlsx'out_f='save_sales_2015.xlsx'parsingExcToWrite(in_f,out_f) #调用

输出：

type(worksheet):write()传入参数类型:

生成的文件效果如下：

上面写成的函数parsingExcToWrite()就是是一个可以使用在读取、处理、写入的框架，如前所说，这两个库不能直接对Excel进行修改，那么读取相应的数据处理后再写入新表就是很好的解决方案。 下面的处理代码如果需要保存处理后的数据就可以基于这段代码进行扩展。

pandas库读写Excel下面看看用pandas进行Excel读取的操作， 读只需要一句话（引入库的不算在内），pd.read_excel(in_fname)，和前一篇笔记读取csv的格式一样，都是生成dataframe数据格式。写入Excel通过pd.ExcelWriter()构建一个Excel写入对象，再对这个对象操作，最后调用 .save()进行写入到硬盘。

import pandas as pd in_f='sales_2015.xlsx'out_f='save_sales_2015_1.xlsx'data_frame = pd.read_excel(in_f, 'january_2015', index_col=None) #对 data_frame进行一些处理dframe_condition = data_frame[:] writer = pd.ExcelWriter(out_f)dframe_condition.to_excel(writer, sheet_name='sheet_name',index=False) writer.save()print('done')#输出： done

筛选与统计量计算因为pandas可以简化一些操作，并且多练pandas是很有意义很重要的，所以下面筛选和统计量的计算都是基于pandas的处理。

有些时候，我们并不需要 Excel 文件中的所有行，特别是数据量很大但是我们只关心满足一定条件的数据。例如，可能只需要包含一个特定的词数值的那些行，或者只需要那些与一个具体日期相关联的行数据。这时候我们就需要进行筛选，去掉不需要的行，只保留需要的行。下面的代码演示了筛选 Sale Amount 大于 $567.00 的行。我们可以通过改变代码data_frame_value_meets_condition = data_frame[data_frame['Sale Amount'].astype(float) > 567.0] 来筛选行中的值满足某个条件的数据。#import pandas as pd #上面引入了这里就不需要重复引入，如果是独立的文件需要写上这句def valConditionExc(in_file,out_file):data_frame = pd.read_excel(in_file, 'january_2015', index_col=None) data_frame_value_meets_condition = data_frame[data_frame['Sale Amount'].astype(float) > 567.0] writer = pd.ExcelWriter(out_file) data_frame_value_meets_condition.to_excel(writer, sheet_name='jan_15_output',index=False) writer.save()#行中的值匹配于特定模式def valMatchPattern(in_file,out_file): data_frame = pd.read_excel(in_file, 'january_2015', index_col=None) df_value_matp = data_frame[data_frame['Customer Name'].str.startswith("J")] writer = pd.ExcelWriter(out_file) df_value_matp.to_excel(writer, sheet_name='jan_15_output',index=False) writer.save() print(df_value_matp)#选择满足一定条件的特定列数据def selectColByIndex(in_file,out_file): data_frame = pd.read_excel(input_file, 'january_2015', index_col=None) df_col_by_index = data_frame.iloc[:, [1, 4]] writer = pd.ExcelWriter(output_file) df_col_by_index.to_excel(writer, sheet_name='jan_15_output',index=False) writer.save()in_f='sales_2015.xlsx'valConditionExc(in_f,'save_sales_2015_2.xlsx')valMatchPattern(in_f,'save_sales_2015_3.xlsx')

输出：

Customer ID Customer Name Invoice Number Sale Amount Purchase Date0 1234 John Smith 100-0002 123 2015-01-014 5678 Jenny Walters 100-0006 345 2015-01-24

使用 pandas 基于列标题选取特定列，一种方式是在数据框名称后面的方括号中将列名以字符串方式列出。另外一种方式是使用 loc 函数。如果使用 loc 函数，那么需要在列标题列表前面加上一个冒号和一个逗号，表示你想为这些特定的列保留所有行。例如下面的代码：

#import pandas as pd def selectAllColByName(in_file,out_file):data_frame = pd.read_excel(in_file, 'january_2015', index_col=None) selected_columns = data_frame.loc[:, ['Customer ID', 'Purchase Date']] #根据列标题选取特定列 writer = pd.ExcelWriter(out_file) selected_columns.to_excel(writer, sheet_name='jan_13_output',index=False) print(selected_columns) writer.save()in_f='sales_2015.xlsx'selectAllColByName(in_f,'save_sales_2015_4.xlsx')

输出：

Customer ID Purchase Date0 1234 2015-01-011 2345 2015-01-062 3456 2015-01-113 4567 2015-01-184 5678 2015-01-245 6789 2015-01-31

大家可以根据代码的效果区分上上部分代码的data_frame.iloc[:, [1, 4]] 和上面的data_frame.loc[:,

['Customer ID', 'Purchase Date']]

.loc for label based indexing.iloc for positional indexing

数据装入pandas的dataframe之后，除了进行筛选，计算一些统计量也是数据分析很重要的工作，描述性统计给我们提供了很多描述数据的指标，下面的代码为工作表的销售数据计算总数和均值。

#import pandas as pd def getSumAndAverage(in_f):all_worksheets = pd.read_excel(in_f,sheetname=None, index_col=None) workbook_total_sales = [] workbook_number_of_sales = [] workbook_mean_sales = [] for worksheet_name, w_data in all_worksheets.items(): total_sales = pd.DataFrame([float(str(value).strip('$').replace(',','')) for value in w_data.loc[:, 'Sale Amount']]).sum() #算一个表的总体销售额 number_of_sales = len(w_data.loc[:, 'Sale Amount']) workbook_total_sales.append(total_sales) #装入一个列表 workbook_number_of_sales.append(number_of_sales) mean_sales=total_sales/number_of_sales #均值 workbook_mean_sales.append(mean_sales) print(worksheet_name,'\t total:',total_sales[0],'\t num:',number_of_sales,'\t mean:',mean_sales[0])in_f='sales_2015.xlsx'getSumAndAverage(in_f)

输出：

january_2015 total: 3201.0 num: 6 mean: 533.5february_2015 total: 55007.0 num: 6 mean: 9167.83333333march_2015 total: 246045.0 num: 6 mean: 41007.5

对于日常办公过程中，每天面对的操作离不开文件、文件夹的操作，当然可以用资源管理器、Everything之类的管理软件来管理。但涉及到批量操作时，在Excel环境或许是个更好的方式，前面很多的内容中不断地有使用过部分的文件、文件夹的函数，今天系统给大家介绍下在Excel催化剂里所开发出的文件、文件夹相关的函数。

具体函数介绍

这一系列的函数传入的参数都较为简单，除了获取所有文件GetFiles和获取所有文件夹GetSubFolders这两个函数需要传入较多的参数来满足复杂的筛选或遍历子文件夹等需要，其他的函数都是1个或2个参数即可。

GetFiles函数

一般来说是返回多个值的，即一个文件夹内有多个文件路径。一般来说传入第1个顶层文件夹路径即可。其他参数可应对不同的需要。

其他函数参数说明如下：

containsText：查找的文件名中是否需要包含指定字符串，不传参数默认为返回所有文件，可传入复杂的正则表达式匹配isSearchAllDirectory 是否查找顶层目录下的文件夹的所有子文件夹，TRUE和非0的字符或数字为搜索子文件夹，其他为否，不传参数时默认为否optAlignHorL 返回的结果是按按列排列还是按行排列，传入L按列排列，传入H按行排列，不传参数或传入非L或H则默认按列排列

GetSubFolders函数

用法几乎和GetFiles一样，只是containsText查找时，可以查找任一层文件夹包含正则pattern匹配项即可。而GetFiles的containsText仅对文件名作匹配。

GetDirectoryName函数

获取上一级的文件夹全路径。

GetFolderByDepth函数

获取指定目录下的不同层级的文件夹名称

GetFileOrDirAttributes函数

获取文件或文件夹属性

IsFileOrDirExist函数

判断传入的文件或文件夹路径是否是真实存在

GetFileSize函数

获取文件大小，单位KB

GetFileOrDirCreateTime函数

获取文件或文件夹创建时间

GetFileOrDirModifyTime函数

获取文件或文件夹最后修改时间

GetFileName函数

GetFileNameWithoutExtension函数

GetFileExtension函数

PathCombine函数

用于合并多段文件夹或文件名使用，无需处理多段名称的后面是否有结束符\如果是最后一个是文件的路径，需要带上文件后缀名，单纯的文件后缀不能作为最后的参数传入，否则不是完整的路径或是错误的方式组合。

总结

使用本篇的文件、文件夹函数，可以轻松获得文件、文件夹路径，并对获得之后的路径作字符串处理，较一般的方式进行字符串处理来得高效，同时也提供了获取文件、文件夹的一些属性信息如文件大小、创建、修改日期等，大大地方便了对文件、文件夹信息的获取及后续的对不同数据的筛选排序等操作。此篇的函数实现，个人觉得还是很能提升日常工作效率的，很值得推荐使用。

或许你看过不同的VBA程序的运行，对于窗口的切换一定印象深刻。在程序运行时，根据不同的需求，窗口在不同的工作表间自由的切换，可以先从一个工作表取值，放到第二个工作表中，再从其他的工作表中取出参数并参与运算，运算得出结果，放到一个单独的工作表中，看的人眼花缭乱。

这种运算是VBA所特有的。虽然在运行时会产生很多的碎片，影响时间的利用，但对于单纯的运算来讲，还是节约了时间，最主要的是提高了数据的准确性和可信度。

在羡慕别人的同时，是否也希望自己能做出这样的程序呢？当然，对于每位学习VBA的朋友来说，这是很自然的事情，学以致用，利用自己的所学。从VBA入手点滴的积累，总会有所收获，正如你经常来我这个平台，福不唐捐，总会能碰到你急于掌握的知识一样。前些时有位朋友留言，说是帮了他大忙，但我确实不知道这位朋友的大忙是什么，也并非给这位朋友定制的，总是机缘吧。

闲话少叙，其实这个实现起来很简单的，今天就给大家讲解一下利用VBA如何控制窗口的切换。

我们先看下面的代码：

11 Dim AppPATH

12 AppPATH = ActiveWorkbook.Path

13 ChDir AppPATH

14 Workbooks.Open FileName:=AppPATH & "\XX.XLS" '打开文件

15 Sheets("SHEET1").Select

16

17 Do While .Cells(I, 1).Value <>""

18-90 '提取数据’

91 I = I + 1

92 Loop

93

94 ActiveWindow.Close (False) '关闭文件

95

96 Windows("LUMAN").Activate

97

98 Sheets("SHEET1").Select

99-199 '执行操作

200

201 Sheets("SHEET2").Select

201-230 '执行操作

231

232 MsgBox ("ok!")

233

程序讲解，上面的代码是一个名为LUMAN.xls的EXCEL的VBA部分代码，当执行到第11行时，程序会识别一下路径，进而打开一个在同文件夹下名字为XX的文件。

15-93行程序会在此文件中进行操作，此时窗口的文件就是这个XX的文件，当执行到第94行时，文件XX会自动的关闭

执行到第95行时，活动窗口又回到了LUMAN的文件，先在SHEET1中进行操作，然后到SHEET2中进行操作。

所有操作执行完成后弹出对话框”OK”。

上面的代码在运行的过程中用到了两个文件，并在期间切换运行，窗口的可视性非常的好，这点比其他程序要友好，如VB6的控件，GO对EXCEL的操作。这也是强大的EXCEL的功能造就的。

当然，对于初识VBA的朋友，上面的讲解不是很解渴，不过没关系的，上面的文章中引入了很多的知识点，如：如何获得当前的地址,如何打开一个文件，如何关闭一个文件，如何把窗口切换到另外的文件等等，只要你掌握了其中之一，就有收获，而且是不小的收获。

今日内容回向：

1 VBA如何获得当前的地址,

2 VBA如何打开一个文件，

3 VBA如何关闭一个文件，

4 VBA如何把窗口切换到另外的文件

5 如何提高程序的可视性

6 如果不关闭上一个窗口，是否会影响到下面的操作？

分享成果，随喜正能量

1.如何将【开发工具】选项卡添加到Excel页面

默认情况下，因为大多数人并不经常用到【开发工具】选项卡，所以微软将其隐藏了起来，打开方式如下：

1.1.office2010及其以上版本：

（1）.【文件】===》【选项】===》【自定义功能区】===》【主选项卡】===》在功能区的“复选 框”中找到【开发工具】选项，并将其选中

（2）.打开Excel后，在默认界面下，将鼠标移动至任意“选项卡”所在区域，单击右键选择【自定义功能区】===》 【主选项卡】===》在功能区的“复选框”中找到【开发工具】选项，并将其选中

1.2.office2007版：

点击【office】===》【Excel选项】===》【常用】===》在功能区找到【开发工具】复选框并将其选中

说明：如果上述方法无法实现，说明office软件安装过程中没有安装VBA如果仍要使用VBA，建议重新安装office

2.允许Excel运行VBA

默认情况下，为避免VBA产生宏病毒污染破坏电脑运行，office禁止了VBA代码的正常运行，要想正常运行VBA，需要先解除禁止，如下：

2.1.office2010及其以上版本：

【开发工具】选项卡===》宏安全性===》【宏设置】===》将【启用所有宏】选中===》【确定】===》重启EXcel

2.2. office2007版：

【工具】===》【宏】===》【安全性】===》【宏设置】===》将【启用所有宏】选中===》【确定】===》重启EXcel

3.打开VBE（Visual Basic Editor）

3.1.快捷键：Alt + F11

3.2.手动方式：【开发工具】===》【Visual Basic】===》【VBE界面】

4.开始编写VBA

和大多数的IDE一样，VBE分为基本的【菜单栏】，【工具栏】，【工程资源管理器】，【属性区域】，【代码区域】以及【状态栏】，一般编写的代码称为“宏”，多个宏又可以组合成一个“模块”，但在【工程资源管理器】中默认情况下是没有模块的，需要通过录制宏或手动插入模块，如下

4.1. 手动插入模块

在【工程资源管理器】中的空白区域或选中单击右键===》【添加】===》【模块】

4.2录制宏

【开发工具】===》【录制宏】===》命名===》【确定】===》完成一系列表格操作后===》【停止录制】===》【宏】===》点击录制的宏===》【编辑】，即可看到VBE中新增了一个模块

因为文档中有宏，开启宏就可以了，操作方法如下：

1.打开office excel 2013,鼠标单击“文件”。

2.鼠标单击“选项”。

3.鼠标单击“信息中心”。

4.单击“信息中心设置”。

5.选择”宏设置“------启用所有宏”。

6.鼠标单击“确定”。宏启用完成。

（本文内容由百度知道网友茗童贡献）

在excel办公中，用VBA加上SQL语句实现对excel表格的数据获取，对于处理一些大数据量的表格来说是非常实用的。SQL是结构化查询语言，是数据库开发中用的程序设计语言，数据库里的数据表跟EXCEL里的表格其实是很类似的，所以用VBA加SQL语句可以实现类似的表格查询操作。

举个例子：在EXCEL里用VBA+SQL来查询总成绩大于290分的学生

一、手工操作的步骤是：

1、 EXCEL打开如下表格，点击插入-数据透视图，点击创建数据透视图

2、 在出现的数据透视图界面，点击姓名为行标签，点击成绩为求和项字段

3、 在左侧的出现的行标签和求和项表格数据进行排序，手工选出成绩大于290分的记录。

用上面的数据透视图方法很方便，步骤也少，比分类汇总功能要简便些。

二、VBA加上SQL语句实现EXCEL表格数据的查询

1、 先用EXCEL打开表格，调出VBE工程界面（ALT+F11），建议在个人工作簿新建个模块，把代码输入到右侧的区域。注：用个人工作簿的好处是，每次启动EXCEL不用手动启用宏。

2、 根据自己的表格字段和功能需求，修改好SQL代码后，保存按F5快捷键运行。注：SQL语句中表名要用[表名$]这种写法。

以上是在EXCEL用VBA加SQL语句实现对表格的自动查询，调用的方法是按ALT+F8,选择相应的代码名称，这里的名称是SQL查询。用这种方法对于规则不经常变动的情况下使用很实用，特别是在数据量大的情况下。

附上截图代码

Sub SQL查询()

Dim cnn As Object, rs As Object, SQL As String

Set cnn = CreateObject("adodb.connection") '创建数据库连接

cnn.Open "Provider=Microsoft.jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & ActiveWorkbook.FullName

Set rs = CreateObject("adodb.recordset") '创建一个数据集

SQL = "select 姓名,sum(成绩) from [原始数据$] group by 姓名 HAVING sum(成绩)>290" '设置SQL查询语句，这个根据实际需要改写，注意【表名$】这种写法

Set rs = cnn.Execute(SQL) '执行查询

ActiveWorkbook.Worksheets(2).Cells.ClearContents

Dim i As Integer

For i = 1 To rs.Fields.Count

ActiveWorkbook.Worksheets(2).Cells(1, i) = rs.Fields(i - 1).Name '填写标题到表2

Next

ActiveWorkbook.Worksheets(2).Range("a2").CopyFromRecordset rs '复制记录集到表2

rs.Close

Set rs = Nothing

cnn.Close

Set cnn = Nothing

End Sub

对于EXCEL2007版本的电子表格，以上的cnn.Open后的字符串要改成"Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ActiveWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=YES"";"""

1、 根据条件删除行

Sub deleteRows(strTable, condition1, condition2)

Dim i, j, iMax, jMax As Long

Dim iicondition1, iicondition2 As Integer

With Worksheets(strTable)

iMax = .UsedRange.Rows.Count

jMax = .UsedRange.Columns.Count

i = 2

Do While i < iMax + 1

iicondition1= .Cells(i, 1)

iicondition2 = .Cells(i, 2)

If (iicondition1= condition1And iicondition2 = condition2) Then

.Rows(i & ":" & i).Delete shift:=xlUp

iMax = iMax - 1

Else

i = i + 1

End If

Loop

End With

End Sub

2、 删除所以的使用range

Worksheets("sheetName").UsedRange.Delete shift:=xlUp

3、打开某指定路径的文件夹对话框

Function GetFileName(ByVal DialogType As MsoFileDialogType, ByVal defaultPath As String) As String

With Application.FileDialog(DialogType)

.Title = "XXXX:"

.AllowMultiSelect = False

.Filters.Clear

.Filters.Add "Excel Files", "*.xlsm"

.Filters.Add "All Files", "*.*"

.InitialFileName = defaultPath

If .Show = True Then

GetFolderName = .SelectedItems(1)

End If

End With

End Function

4、截取字符段

从右边开始，查找某字符，然后截取其后面的字符串。

xlsPath2 = Right(xlsPath, InStr(StrReverse(xlsPath), "\") - 1)

5、Sharepoint数据的刷新

Worksheets("Sharepoint对应的sheet").Range("A1").ListObject.QueryTable.Refresh BackgroundQuery:=False

6、当前使用的range的取得

.UsedRange ‘对应的range

.UsedRange.Rows.Count ‘对应的行号

.UsedRange.Columns.Count 对应的列号

7、在Excel内部打开另外一个Excel （不显示，隐藏）并读取其数据

Set xlsApp = New Excel.Application

xlsApp.Visible = False

xlsPath = ThisWorkbook.Path

Set xlsWB = xlsApp.Workbooks.Open(xlsPath, Null, ReadOnly)

‘读取/写入对应的sheet

X = xlsWB.worksheets(“xxxx”).cells(i,j)

xlsWB.worksheets(“xxxx”)..Cells(i, j).Formula = "=E” & i

8、计算处理

'如果你的表中有大量的计算单元格，那就需要关闭自动计算，否则慢的要死

‘在VBA开始，设置为手动

'Application.Calculation = xlCalculationManual

'Application.ScreenUpdating = False

‘在VBA开始，设置为自动

'Application.Calculation = xlCalculationAutomatic

'Application.ScreenUpdating = False

注意，还有一种方法是再打开本excel的时候，就设置为手动，对于需要计算的sheet，单独在其数据填充完毕后，执行计算操作。

例如： Worksheets("XXXXX”).Calculate ‘这是效率最高一种方法。当然，你也可以对某些range，单独进行range计算。

9、Range到range的只读拷贝、黏贴

Worksheets("srcSheet").Range(.Cells(1, 1), .Cells(x,y)).Copy

Worksheets("dstSheet").Cells(1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

10、Cell内容的替换操作

Worksheets("CostTable").Cells.Replace What:="Original Content", Replacement:="replease Content", LookAt:=xlPart, _

SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

11、自动填充

Worksheets("xxxx")..Range("D8:F8").AutoFill Destination:=.Range(.Cells(8, 4), .Cells(rMax, 8)), Type:=xlFillDefault

12、获取pivot的使用区域、

Set pvt = Worksheets("xxxx").PivotTables("PivotTable_xxxx")

Set rngTable = pvt.TableRange1

13、刷新pivot

Worksheets("xxxx").PivotTables("PivotTable_xxxx").PivotCache.Refresh

在excel的使用过程中，有时候我们需要将同目录下有着相同标题的多个excel工作簿合并到一个excel工作簿中，比如下面这种情况，5个年级的学生名单合并到一个表里面去。

常用的做法是手工打开每个文件，复制粘贴到学生名单汇总一个表里去。

这里介绍一个偷懒的方法，用VBA代码自动合并。代码分4段，第1段是主代码，后面3段是自定义函数。建议把代码复制粘贴到个人工作簿的模块里，方便调用。打开学生名单汇总.xlsx ALT+F8运行该代码。

以下是具体代码，复制粘贴

Sub 同目录下合并多个excel工作簿()

'On Error Resume Next '// 发生错误，自动执行下一句，就是忽略错误

Application.ScreenUpdating = False '//关闭屏幕刷新

Application.DisplayAlerts = False '//关闭系统提示

t = Timer '//开始时间

Set SH0 = ActiveWorkbook.Worksheets(1)

SH0.Cells.Clear '//清空保存区域，全部数据第一行是标题行，且只占一行，无合并单元格

ARR = FileAllArr(ActiveWorkbook.Path, "*.xlsx", ActiveWorkbook.Name, False) '//详见函数说明

SHName = "sheet1" '//要求所有工作簿内需要统计的工作表名称相同，

For i = 0 To UBound(ARR)

Str_coon = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=yes';data source=" & ARR(i) '//Excel2007

' Str_coon = "Provider=Microsoft.JET.OLEDB.4.0;Extended Properties='Excel 8.0;HDR=yes';data source=" & & ARR(I) '//OFFICE2003，根据情况选择

StrSQL = "SELECT *,'" & GetPathFromFileName(ARR(i), False) & "' AS 来自工作簿 FROM [" & SHName & "$]" '//SQL语句自己发挥吧，这里是精髓。

IROW = SH0.Range("A1048576").End(3).Row + 1

If IROW <= 2 Then

IROW = 1

Crr = GET_SQLCoon(StrSQL, Str_coon, True) '//第一次，带上标题

Else

Crr = GET_SQLCoon(StrSQL, Str_coon, False)

End If

SH0.Range("A" & IROW).Resize(UBound(Crr, 1) + 1, UBound(Crr, 2) + 1) = Crr '//粘贴查询结果

Next

Application.ScreenUpdating = True '//恢复屏幕刷新

Application.DisplayAlerts = True '//恢复系统提示

MsgBox "汇总用时：" & Format(Timer - t, "#0.0000") & " 秒", , "北极狐提示!!" '//提示所用时间

End Sub

Rem 下面是为方便整理的自定义函数，上面的代码执行必不可少哟！！

'*******************************************************************************************************

'功能： 查找指定文件夹含子文件夹内所有文件名或文件夹名（含路径）

'函数名： FileAllArr

'参数1： Filename 需查找的文件夹名 不含最后的"\"

'参数2： FileFilter 需要过滤的文件名，可省略，默认为：[*.*]

'参数3： Liwai 剔除例外的文件名，可省略，默认为：空，一般为：ThisWorkbook.Name

'参数4： Files 是否只要文件夹名，可省略，默认为：FALSE

'返回值： 一个字符型的数组

'使用方法：arr = FileAllArr(ThisWorkbook.Path, "*.xls", ThisWorkbook.Name,false)

'*******************************************************************************************************

Public Function FileAllArr(ByVal Filename As String, Optional ByVal FileFilter As String = "*.*", Optional ByVal Liwai As String = "", Optional ByVal Files As Boolean = False) As String()

Set Dic = CreateObject("Scripting.Dictionary") '创建一个字典对象

Set Did = CreateObject("Scripting.Dictionary")

Dic.Add (Filename & "\"), ""

i = 0

Do While i < Dic.Count

Ke = Dic.keys '开始遍历字典

MyName = Dir(Ke(i), vbDirectory) '查找目录

Do While MyName <>""

If MyName <> "." And MyName <> ".." Then

If (GetAttr(Ke(i) & MyName) And vbDirectory) = vbDirectory Then '如果是次级目录

Dic.Add (Ke(i) & MyName & "\"), "" '就往字典中添加这个次级目录名作为一个条目

End If

End If

MyName = Dir '继续遍历寻找

Loop

i = i + 1

Loop

Dim arrx() As String

i = 0

If Files = True Then '//是否只输出文件夹名

For Each Ke In Dic.keys '以查找总表所在文件夹下所有excel文件为例

ReDim Preserve arrx(i)

If Ke <> Filename & "\" Then '//自身文件夹除外

arrx(i) = Ke

i = i + 1

End If

Next

FileAllArr = arrx

Else

For Each Ke In Dic.keys '以查找总表所在文件夹下所有excel文件为例

MyFileName = Dir(Ke & FileFilter) '过滤器：EXCEL2003为：*.xls,excel2007为：*.xlsx

Do While MyFileName <>""

If MyFileName <> Liwai Then '排除例外文件

ReDim Preserve arrx(i)

arrx(i) = Ke & MyFileName

i = i + 1

End If

MyFileName = Dir

Loop

Next

FileAllArr = arrx

End If

End Function

'****************************************************************

'*'****************************************************************************************************

'函数: GetPathFromFileName 根据全路径获得文件名

'参数1：strFullPath 完整路径

'参数2：kzm true 返回字符串含扩展名

'参数3：strSplitor 各级文件夹分隔符

'作用: 从完整路径获取返回: 文件名(true带扩展名)

'使用方法: msgbox GetPathFromFileName("C:\windows\text.txt",true)

'*'****************************************************************************************************

Public Function GetPathFromFileName(ByVal strFullPath As String, Optional ByVal kzm As Boolean = True, Optional ByVal strSplitor As String = "\") As String

Dim FileName1 As String

Dim FNAME As String

FileName1 = Left$(strFullPath, InStrRev(strFullPath, strSplitor, , vbTextCompare))

FileName1 = Replace(strFullPath, FileName1, "")

If kzm = False Then

GetPathFromFileName = Left(FileName1, InStr(FileName1, ".") - 1)

Else

GetPathFromFileName = FileName1

End If

End Function

'*'****************************************************************************************************

'*****************************************************************************************

'函数名： GET_SQLCoon

'函数功能： 获得指定SQL的查询结果，自定义连接字符串，可以连接各种数据库

'返回值： 返回一个二维数组

'参数1： StrSQL 字符类型 SQL查询语句

'参数2： Str_coon 字符类型 数据库连接语句

'参数3： Biaoti 可参数选 是否输出标题，默认带有标题

'使用方法： Arr = GET_SQLCoon(StrSQL,Str_coon,true)

' Arr(0,1) '//数组第一行为标题行，从i=1 开始是数据

' Sh2.Range("A2").Resize(UBound(ARR, 1) + 1, UBound(ARR, 2) + 1) = ARR

'*****************************************************************************************

Public Function GET_SQLCoon(ByVal StrSQL As String, ByVal Str_coon As String, Optional Biaoti As Boolean = True) As Variant()

On Error Resume Next ' 改变错误处理的方式。

Dim Cn, RS

Err.Clear

Set Cn = CreateObject("Adodb.Connection") '//新建一个ADO连接

Set RS = CreateObject("adodb.recordset")

Cn.Open Str_coon

RS.Open StrSQL, Cn, 1, 3

If RS.RecordCount > 0 Then '//如果找到数据

If Biaoti = True Then

ReDim ARR(0 To RS.RecordCount, 0 To RS.Fields.Count - 1)

For a = 0 To RS.Fields.Count - 1 '//导入标题

ARR(0, a) = RS.Fields(a).Name

Next

For i = 0 To RS.RecordCount - 1 '//导入数据

For a = 0 To RS.Fields.Count - 1

ARR(i + 1, a) = RS.Fields(a).Value

Next a

RS.MoveNext

Next

Else

ReDim ARR(0 To RS.RecordCount - 1, 0 To RS.Fields.Count - 1)

For i = 0 To RS.RecordCount - 1 '//导入数据

For a = 0 To RS.Fields.Count - 1

ARR(i, a) = RS.Fields(a).Value

Next a

RS.MoveNext

Next

End If

Else '//如果没有找到数据

ReDim ARR(1, 1)

ARR(0, 0) = ""

End If

GET_SQLCoon = ARR

Cn.Close '//关闭ADO连接

Set RS = Nothing

Set Cn = Nothing '//释放内存

End Function

'*****************************************************************************************

前言

首先需要感谢看官您抽空观赏本文，若有任何问题，欢迎您的指正。

另外大家若有什么好的想法或者效果需求，可以在评论区留言或者私信我，我会尽力尝试做一做。

如果您喜欢本文的话，可以点赞、订阅、关注、收藏、留言评论哦！谢谢！O(∩_∩)O~~

情景还原 - 请您听我说

Excel - VBA 让表格处理变得更简单、更便利、更有趣。

平常我们从其他Excel表格Copy数据出来的时候，往往都会将源数据表格打开，然后提取我们所需要的部分数据；

将这个流程整理出来就是：①打开文件资源管理器，花若干秒找到文件；②花若干秒打开文件；③选中全文并Copy（若不熟练Excel快捷键等，可能Copy过程要多耽误几秒）；④回到需要数据的文档粘贴下来（若开的文件较多，可能切换时也要耽误几秒）。

那这上面的看似复杂的流程，可否有便利快捷的办法完成呢？

答案肯定是 —— 有。用VBA代码就能将上面的流程简化到只要【找文件】这一步。

功能介绍 - “吹”来“吹”去

流程简洁方便，只需要找到那份文档即可；

若源数据文档只有一个工作表，则直接汇入数据；

若待汇入源数据文档含有多个工作表，会提示选择需要汇入的表格；

若输入非关键值，则会报错并重新提示输入值。

效果演示 - 调皮的 GIF 环节

依旧是那句：万般文字也不如一个视频或者一张GIF演示来的痛快，请看官您静静观赏。

首先是一份正常使用情况下的完成流程：

调皮的 GIF 图有点点长 ~.~

当输入关键字时，输入非列表内的对应序号，则会报错提示，并重新回到输入关键字的界面：

确认选择的文件

输入 “WW” 不符合要求

报错提示信息

输错啦！请重新输入.GIF

VBA代码 - Tab / Space

效果演示看完了，那么就为您附上代码，供您慢慢检验：

VBA 代码

PS：若有看官觉得图片还不够清晰，无法尝试，您可以在评论区留言，我会私信回复您。若需要代码的看官比较多（比如100位），那么我会将文本代码直接以文章推送出来供大家查阅。

【关于私信，目前可能需要看官您先发送私信给我，作为作者这边无法直接向您发信息，若您曾给我发过私信且未将对话关闭，我这边就能从历史记录中向您发送信息。】

文末 - 谢谢您嘞，(づ￣3￣)づ╭

每一位读者的点赞、订阅、关注、收藏、留言评论都是对我的最大支持，谢谢各位帅哥美女！

同时也希望大家多多转发与评论留言，毕竟只有更多的人认可，我才更有动力为大家发布文章，提供代码。

再次谢谢大家！

友情链接 - 值得一看

1、Excel-VBA 让录入数据变得更智能——输入时提示匹配值

2、Excel-VBA 将乱序的数据剔除空值后有序排列成一列或一行

3、Excel-VBA 实时记录表格异动

4、Excel-VBA “十字星”聚焦效果