excel - 更改代码以允许选择多个文件
问题描述
我一直在使用宏将多个 .txt 文件导入到我的活动 Excel 工作簿中(请参见下文)。我想以一种允许我选择要导入的文件并以相同方式运行的方式对其进行更改。我尝试使用“ Application.GetOpenFilename(FileFilter:="Text Files ( .txt), .txt", MultiSelect:=True, Title:="Text Files to Open") ”,但出现类型不匹配错误。我觉得这应该不是什么大问题,但我似乎无法解决这个问题。
任何建议都非常感谢。
Sub TxtImporter()
Dim f As String, flPath As String
Dim i As Long, j As Long
Dim ws As Worksheet
Application.DisplayAlerts = False
Application.ScreenUpdating = False
flPath = ThisWorkbook.Path & Application.PathSeparator
i = ThisWorkbook.Worksheets.Count
j = Application.Workbooks.Count
f = Dir(flPath & "*.txt")
Do Until f = ""
Workbooks.OpenText flPath & f, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=True, _
Space:=False, Other:=False, TrailingMinusNumbers:=True
Workbooks(j + 1).Worksheets(1).Copy After:=ThisWorkbook.Worksheets(i)
ThisWorkbook.Worksheets(i + 1).Name = Left(f, Len(f) - 4)
Workbooks(j + 1).Close SaveChanges:=False
i = i + 1
f = Dir
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
解决方案
请尝试您的代码(这是一段很好的代码),稍微调整一下
Sub TextImporter2()
Dim f As String, flPath As String
Dim i As Long, j As Long
Dim ws As Worksheet
Application.DisplayAlerts = False
Application.ScreenUpdating = False
flPath = ThisWorkbook.Path & Application.PathSeparator
i = ThisWorkbook.Worksheets.Count
j = Application.Workbooks.Count
FileNames = Application.GetOpenFilename(FileFilter:="Text Files (*.txt), *.txt", MultiSelect:=True, Title:="Text Files to Open")
If VarType(FileNames) = vbBoolean Then
MsgBox "No Files Selected"
Exit Sub
End If
For Fno = LBound(FileNames) To UBound(FileNames)
Workbooks.OpenText FileNames(Fno), _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=True, _
Space:=False, Other:=False, TrailingMinusNumbers:=True
f = ActiveWorkbook.Name
Workbooks(j + 1).Worksheets(1).Copy After:=ThisWorkbook.Worksheets(i)
ThisWorkbook.Worksheets(i + 1).Name = Left(f, Len(f) - 4)
Workbooks(j + 1).Close SaveChanges:=False
i = i + 1
Next Fno
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
如果对你有帮助,我会很高兴。但是,您可以在命名新添加的工作表并添加预防措施之前检查工作表名称的存在。
推荐阅读
- laravel - 错误非法长度修饰符在 s[np]printf Laravel 中指定了 'f'
- php - 查找一个多维数组中的所有元素是否存在于另一个中(使用多维数组作为大海捞针)
- post - 如何在 esp32 中使用 shlib(nghttp2) 发送一大块数据?
- python - 在句子级别找到每个单词的频率
- c - 在 C 中生成大小为 10^6 的数组
- javascript - 是否可以不使用 Pine 脚本为交易视图编码?
- material-ui - MUI V5 - MakeStyles 样式被覆盖
- flutter - 有什么方法可以强类型地使用 Navigator?
- python - groupby 一列以获取另一列中的最小值和对应值
- python - 如何使用 re.split() 分割两个字符的实例?