通过VBA将多选中文件拆分导入多工作表的实现与优化
VBA批量导入多文本文件至对应工作表的需求与问题
这是我首次在本论坛提问,此前论坛中的各类解答一直为我提供了很大帮助。但最近我被一个问题困扰数周,始终未找到足够完善的解决方案:
我当前的任务是对现有用于数据处理与展示的宏进行升级,适配更新的UI界面、提升易用性,同时优化宏的运行速度。
核心需求
目前我遇到的核心问题是:如何将选中的多个.txt文件完成打开、加载、拆分操作后,粘贴到以对应文件名命名的不同工作表中。这类文件通常可快速达到超10万条数据的规模,所有数据以空格或回车作为分隔符。
现有单文件导入实现
针对单文件的导入与拆分需求,我找到了适配场景的可用代码:
Private Sub testModule1() Dim arr, tmp, output Dim Datei Dim FSO Dim x, y As Integer Dim str_string, filePath As String Set FSO = CreateObject("Scripting.FilesystemObject") filePath = Application.GetOpenFilename Set Datei = FSO.OpentextFile(filePath) str_string = Datei.readall Datei.Close arr = Split(str_string, vbCrLf) ReDim output(UBound(arr), 50) For x = 0 To UBound(arr) tmp = Split(arr(x), " ") For y = 0 To UBound(tmp) output(x, y) = tmp(y) Next Next Sheets("Sheet1").Range("A1").Resize(UBound(output) + 1, UBound(output, 2)) = output End Sub
上述代码可实现单文件选择、按要求拆分单元格内容,最终将数据写入Sheet1工作表。
多文件导入方案现存缺陷
针对多文件导入、并以文件名作为工作表名称的需求,我找到的公开参考方案存在以下问题:
- 实现逻辑是在新工作簿中打开导入内容,操作时会多次弹出数据覆盖提示
- 支持的分隔符仅限单个字符,无法满足实际使用需求
- 旧版宏的实现逻辑是先提取所有文件路径存储到单元格中,后续循环遍历单元格读取、整合单份数据,所有数据都存放在同一张工作表中,实现方式过于繁琐
我希望能找到更优雅的解决方案,无需在编辑过程中将数据暂存到工作表中,也欢迎大家提供其他相关建议与解决方案。
调整后代码的性能问题
在Solar Mike的提示下,我将代码调整为如下版本:
Private Sub testModule2() Dim fDialog As FileDialog Dim fPath As Variant Dim FSO Dim Datei Dim arr, tmp, output Dim file, fileName As String Dim x, y As Integer Dim newSht As Worksheet Application.ScreenUpdating = False Set fDialog = Application.FileDialog(msoFileDialogFilePicker) With fDialog .AllowMultiSelect = True .Title = "Please select files to import" .Filters.Clear .Filters.Add "VBO Files", "*.vbo" If .Show = True Then For Each fPath In .SelectedItems Set FSO = CreateObject("Scripting.FilesystemObject") fileName = FSO.GetFilename(fPath) Set Datei = FSO.OpentextFile(fPath) file = Datei.readall Datei.Close arr = Split(file, vbCrLf) ReDim output(UBound(arr), 50) For x = 0 To UBound(arr) tmp = Split(arr(x), " ") For y = 0 To UBound(tmp) output(x, y) = tmp(y) Next Next Set newSht = ActiveWorkbook.Sheets.Add(after:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count)) newSht.Name = fileName Sheets(fileName).Range("A1").Resize(UBound(output) + 1, UBound(output, 2)) = output Next End If End With Application.ScreenUpdating = True End Sub
调整后的代码已经可以实现核心需求,但仅导入5个文件就需要约1分钟。由于日常使用场景下平均需要导入最多20个文件,后续还要开展数据处理工作,当前的运行速度仍有较大优化空间。
需要说明的是,后续数据处理环节会过滤掉40%-80%的数据集,但我目前没有足够的技术能力在导入阶段完成过滤操作来缩短加载时长,希望得到相关指导。
内容的提问来源于stack exchange,提问作者Henir
相关产品推荐
相关产品推荐

