|
昨个发时忘记改素材版本的标题了…… 因此删了今重发…… 杯具…… 大家好，今天周三，又到了点播时间了。 有朋友发消息问能否用代码实现多表合并计算的功能。 嗯，先说下什么是“合并计算”。 它是Excel自带的一个功能，位于【数据】选项卡下的【数据工具组】中。 它的主要功能是根据指定的多个（单表或多表甚至多工作簿）单元格区域进行合并计算，一般常用于多表数据统计。 比如下面这个小动画，5秒即可搞定多表数据统计。 嘿~！是不是很简便很实用~ ~我们现在的问题是，如何用VBA代码执行上面动画的操作过程，方便数据自动化处理。 代码如下： Sub ConsolidateSheets() 'EH技术论坛公众号VBA编程学习与实践 Dim Sht As Worksheet Dim r, k&, i& ReDim r(1 To 1) For Each Sht In Worksheets '遍历工作表 If Sht.Name <> ActiveSheet.Name Then k = k 1 ReDim Preserve r(1 To k) '动态设置数组大小 r(k) = Sht.Name & '!' & Sht.UsedRange.Address(ReferenceStyle:=xlR1C1) '数据区域地址以r1c1形式装入数组r End If Next Cells.ClearContents '清除当前表数据 Range('a1').Consolidate sources:=r, Function:=xlSum, toprow:=True, leftcolumn:=True 'Consolidate合并计算语句，基于行列汇总，求和形式。 MsgBox '合并计算OK' End Sub 小贴士： 1，代码将数据汇总到当前表中，因此在运行代码前，务必先激活放置汇总数据的表格。 2，在多表数据汇总合并的问题上，合并计算的优点是，它支持标题行乱序,甚至数量不一致的情况，例如一张表的标题行是语文、数学、英语，其它表的标题行为英语、语文、数学等，并不妨碍合并计算统计结果正确性。 3，但……合并计算要求标题行和列只能单行或单列。而且，除了指定的标题行和列以外的区域，均被视为统计区域，若其中含有文本，则忽略不统计。 致命的是第2点，这使得合并计算的功能大打折扣了，正因如此，该功能才鲜有人知吧。在VBA编程上，更多的时候，我们是通过ADO SQL 字典做多表标题行乱序的数据统计。 最后附Consolidate方法的说明 Range.Consolidate(Sources, Function,TopRow, LeftColumn, CreateLinks) The End 如何获取指定文件夹下文件的名称？ 很久以前（2年前？）我们分享过DOS的方法，操作动画如下： VBA可以通过Wscript.Shell调用DOS语句，以后我们可能会分享到这部分内容~所以这里先简单说下动画中DOS语句的意思 DIR *.*/B>LIST.TXT DIR可以简单理解成函数。 *.* *是通配符，第一个*是文件名，第二个*是文件格式。如果只要excel文件，就修改为*.xls。 /b 是使用空格式，没有标题信息之类的。 list.txt是生成的文件类型和名字。 综上所述，如果是生成excel文件的目录，并以excel来呈现，命名为目录，语句就改为DIR *.xls /B >目录.xls . . 除了DOS的方法还有浏览器法、函数法以及我们今天分享的VBA法。 函数法如下图所示，浏览器法这里就不啰嗦介绍了。 看我眼睛，先声明，动画里的政治经济学和我没关系啊，那是老祝干的事，我作证…… . . 最后说下VBA的方法…… 照例先上操作动画： 代码的核心是DIR语句，注释部分业已作了解释，这里就不再啰嗦了。 Sub FileDir() Dim p$, f$, k& ' ' '获取用户选择文件夹的路径 With Application.FileDialog(msoFileDialogFolderPicker) '选择文件夹 .AllowMultiSelect = False '不允许多选 If .Show Then p = .SelectedItems(1) '选择的文件路径赋值变量P Else Exit Sub '如果没有选择保存路径，则退出程序 End If End With If Right(p, 1) <> '\' Then p = p & '\' ' ' f = Dir(p & '*.*') '返回变量P路径下带任意扩展名的文件名。如果超过一个文件存在，函数将返回按条件第一个找到的文件名。 '如果一个文件都没有，则f返回'' [a:a].ClearContents '清空A列数据 [a1] = '目录' k = 1 'K Do While f <> '' '如果f不等于''，则…… k = k 1 '累加K Cells(k, 1) = f f = Dir ' 若第二次调用 Dir 函数，但不带任何参数，则将返回同一目录下的下一个文件。 Loop ' ' MsgBox 'OK' End Sub 小思考： 如何用VBA判断某个文件夹下是否存在名称为“看见星光”的工作簿？方法有很多种哦~  一码不扫， |
|
|
