搜以致用之合并当前目录下所有工作簿的全部工作表

浮碟 · 发表于 2019-11-25 15:08:52

1.引子

某日，偶得一数据宝库，内含数百 excel 工作簿，每个工作簿又含数万条数据，我的需求是依据关键字查询到某一条数据。天啦撸，像我这种运气差到总是最后一把钥匙才能打开门的人，不能每查询一次就点开几百个工作簿吧。我要解决这个问题，思路就是把它们合并成一个工作簿（原谅我一个excel和数据库小白，只能想到这种简单粗暴的办法，各位大神有更好的思路请不吝赐教）。各种我能想到的关键词一搜，再加上逐一试错，基本排除各种什么经验介绍的方法，最终锁定CNDS社区的一篇VBA代码（因为评论区里有小白成功过，时间久忘记具体是哪一篇贴文了，在此谢过）。然而，自己一试却总是失败，十分头疼抓狂，不过最终还是通过冷静的分析外加搜索的助力，成功解决了问题，现将正确代码和失败原因分享如下：

2.VBA代码

Sub 合并当前目录下所有工作簿的全部工作表()
Dim MyPath, MyName, AWbName
Dim Wb As Workbook, WbN As String
Dim G As Long
Dim Num As Long
Dim BOX As String
Application.ScreenUpdating = False
MyPath = ActiveWorkbook.Path
MyName = Dir(MyPath & "" & "*.xls")
AWbName = ActiveWorkbook.Name
Num = 0
Do While MyName <> ""
If MyName <> AWbName Then
Set Wb = Workbooks.Open(MyPath & "" & MyName)
Num = Num + 1
With Workbooks(1).ActiveSheet
.Cells(.Range("A1048576").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)
For G = 1 To Sheets.Count
Wb.Sheets(G).UsedRange.Copy .Cells(.Range("A1048576").End(xlUp).Row + 1, 1)
Next
WbN = WbN & Chr(13) & Wb.Name
Wb.Close False
End With
End If
MyName = Dir
Loop
Range("A1").Select
Application.ScreenUpdating = True
MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"
End Sub

复制代码

3.操作方法

新建一个excel工作薄，命名后保存到需要合并的多个工作簿所在的文件夹，快捷键alt + f11,双击工程资源管理器里面的sheet1(sheet1),在右侧的代码区粘贴上述代码，执行等待就OK了。

4.失败原因

原来我的excel工作薄里的数据太多了，超出了2003版excel表的最大行数（Excel2003最大行数是65536行，最大列数是256列，Excel2007以上版本最大行数是1048576行，最大列数是16384列）。找到问题根源接下来就好办了，换成excel2007，再把数据合并到一个工作簿的多个工作表，通过同时选中多个工作表来ctrl+f，问题就基本解决了。以上就是我的一次搜以致用的体验，希望也能帮到有需要的虫友。

独角仙之夜 · 发表于 2019-11-25 22:26:01

查找选项中把工作表改成工作簿不行吗？

浮碟 · 发表于 2019-11-26 06:50:47

独角仙之夜发表于 2019-11-25 22:26
查找选项中把工作表改成工作簿不行吗？

合并前工作簿太多，选起来也费劲，关键是我不会同时查找多个工作簿，可以教下我怎么查么？

小无奈 · 发表于 2019-11-26 12:10:29

如果是我的话，会考虑，把每一个工作簿的信息，全部存到数据库里，以后查询的时候，直接用sql 语句就可以查了。。
针对较多的数据，存储在excle 里面会存在数据量过大，打开缓慢，如果你能忍受，我觉得还Ok

浮碟 · 发表于 2019-11-26 12:50:36

小无奈发表于 2019-11-26 12:10
如果是我的话，会考虑，把每一个工作簿的信息，全部存到数据库里，以后查询的时候，直接用sql 语句就可以查 ...

是的，数据库确实方便，但是我的数据库知识多年前已经还给老师了{:5_157:}

小无奈 · 发表于 2019-11-26 13:13:30

浮碟发表于 2019-11-26 12:50
是的，数据库确实方便，但是我的数据库知识多年前已经还给老师了 ...

够用就行，等你真的需要几百万的数据放在一个表格里的时候，在捡起来就完事了{:5_158:}{:5_158:} {:5_158:} {:5_158:} {:5_158:}{:5_158:} {:5_158:} {:5_158:}

独角仙之夜 · 发表于 2019-11-27 09:59:34

浮碟发表于 2019-11-26 06:50
合并前工作簿太多，选起来也费劲，关键是我不会同时查找多个工作簿，可以教下我怎么查么？ ...

查找-选项-范围-工作簿

坤坤 · 发表于 2019-11-27 10:32:31

一、需将excel表转为csv文件方便数据处理和计算。并需要将产生的222个csv文件合并成一个。
参考：https://blog.csdn.net/m0_37717751/article/details/81043721
1、首先把需要导出的Excel文件集中整理到一个文件夹中，并且确定一个用来保存csv文件的路径。#个人建议上述两者不要在一个文件夹里

2、在他处，新建一个Excel文件，点击菜单栏上的“开发工具”，并点击下面的Visual Basic

3、在左侧一栏中双击Sheet1打开代码窗口，输入以下代码：

Sub SaveToCSVs()
Dim fDir As String
Dim wB As Workbook
Dim wS As Worksheet
Dim fPath As String
Dim sPath As String
fPath = "你的excel文件路径，以\结尾"
sPath = "你要存放输出的csv文件的路径，以\结尾"
fDir = Dir(fPath)
Do While (fDir <> "")
If Right(fDir, 4) = ".xls" Or Right(fDir, 5) = ".xlsx" Then
On Error Resume Next
Set wB = Workbooks.Open(fPath & fDir)
'MsgBox (wB.Name)
For Each wS In wB.Sheets
wS.SaveAs sPath & wB.Name & ".csv", xlCSV
Next wS
wB.Close False
Set wB = Nothing
End If
fDir = Dir
On Error GoTo 0
Loop
End Sub

复制代码

4、之后点击菜单栏上的“运行”，选择运行子过程/用户窗体。转换过程中会有多个Excel窗口自动显示再关闭。完成后打开设定的文件夹，就能看到转换后的csv文件。#不知何因，每个csv会额外产生两个空的csv文件，删掉即可。

二、将多个csv合并到一个csv中

1、将所有的csv文件放到一个文件夹中

2、打开cmd，切换到存放csv的文件夹，

3、输入命令copy *.csv 总表的文件名.csv

浮碟 · 发表于 2019-11-27 15:42:15

独角仙之夜发表于 2019-11-27 09:59
查找-选项-范围-工作簿

这个是可行，但前提还是要把众多的工作薄合到一起

hanxj0327 · 发表于 2019-11-27 15:49:45

感谢你的分享，很好用，支持一下。

浮碟 · 发表于 2019-11-27 15:51:25

坤坤发表于 2019-11-27 10:32
一、需将excel表转为csv文件方便数据处理和计算。并需要将产生的222个csv文件合并成一个。
参考：https://b ...

感谢提供新的思路，这个代码简洁，大致能够看懂意思，有时间来试一下。

werevil · 发表于 2019-11-27 16:30:05

我现在看到会代码的人就佩服得五体投地{:5_130:}

独角仙之夜 · 发表于 2019-11-27 22:35:00

浮碟发表于 2019-11-27 15:42
这个是可行，但前提还是要把众多的工作薄合到一起

前面没认真看，学习了！