将文本文件导入主 excel 文档 (VBA)？答案

【问题标题】：Importing text files into master excel document (VBA)?将文本文件导入主 excel 文档 (VBA)？
【发布时间】：2017-10-18 20:36:36
【问题描述】：

我编写了一个代码，允许用户选择一个文件夹，然后循环遍历文件夹中的所有文件，将特定列的数据复制到我的主文档“PQ 分析电子表格”中。

我想改进此代码，使其更通用。

有什么方法可以改变它，这样我就不必将“PQ 分析电子表格”指定为主文档？也就是说，它可以根据用户的意愿进行调用。

此外，我目前将每个文件打开到一个新工作簿中，然后从那里复制。我确定必须有一种方法可以直接从 txt 文件输入到数组中，然后从那里打印？

任何建议将不胜感激。这是我编写的第一个 VBA 代码，所以对这种语言非常陌生！谢谢。

Sub tabdelim()
Dim strFileToOpen
Dim InputFile As Workbook
Dim OutputFile As Workbook

'Dialogue box to select file to open
strFileToOpen = Application.GetOpenFilename _
(Title:="Please choose a file to open", _
FileFilter:="Text Files *.txt* (*.txt*),")

If strFileToOpen = False Then
    MsgBox "No file selected.", vbExclamation, "No file selected!"
    Exit Sub

Else
    'Open selected file in new workbook
    Workbooks.OpenText Filename:= _
    strFileToOpen, _
    Origin:=65001, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
    Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
    Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
    Array(9, 1)), TrailingMinusNumbers:=True


End If


Set InputFile = ActiveWorkbook

'Now, copy what you want from InputFile:
ActiveSheet.Range("I3:I660").Copy


'Now, paste to OutputFile worksheet:
Windows("PQ Analysis spreadsheet.xls").Activate
Set OutputFile = ActiveWorkbook
Range("C43").Select
ActiveSheet.Paste


'Close InputFile
InputFile.Close


End Sub

【问题讨论】：

Dim strWorkbookName As String: strWorkbookName = InputBox("Select a workbook")
使用 Power Query 会更简单、更高效。

标签： excel vba

【解决方案1】：

首先，启动器选择文件，然后开始导入每个文件：

Sub SelectFilesForImport()
    Dim fd  As FileDialog
    Dim i   As Long

    'set and determine file picker behaviors
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    fd.AllowMultiSelect = True

    'Launch file picker, exit if no files selected. 
    'Hold Ctrl to select multiple files. Ctrl+A to select all files
    If Not fd.Show = -1 Then Exit Sub

    'Start import selected files, file by file.
    For i = 1 To fd.SelectedItems.Count
        Call ImportFile(fd.SelectedItems(i))
    Next i
End Sub

第二个子，逐行导入（无需在 Excel 中打开文件）

Private Sub ImportFile(ByVal FilePathAndName As String)
    Dim DataInTransit   As String
    Dim FileName        As String
    Dim N               As Integer

    N = FreeFile
    Open FilePathAndName For Input As #N
        Do While Not EOF(N)
            Line Input #N, DataInTransit

            ' ##################################################
            ' Up to this point, "DataInTransit" is a single line text.
            ' Now it depends on how you want to massage and put it into the worksheet.
            ' You can also skip lines which do not fit into context _
              by adding conditional IF statements.
            ' Modify below to suit your needs:
                Arr = Split(DataInTransit, ";")
                ActiveCell.Resize(1, UBound(Arr) + 1) = Split(DataInTransit, " ")
                ActiveCell.Offset(1).Activate
            ' ##################################################

        Loop
    Close #N
End Sub

对于放置导入的位置，我认为直接放入ActiveCell 更简单，如上面的第二个子，然后偏移到下一行以获取新行。但是如果你有很多计算，它可能会很慢（可以通过自动计算来解决）。否则，按照您的建议，使用数组来收集行，然后将它们一次全部放入工作表中。无论哪种方式，用户只需要选择范围的左上角开始导入（最好提示一条消息，要求他们选择开始放置导入的单元格，否则他们可能会搞砸他们的整个工作表，p/s 还允许他们在提示中取消宏以防万一）。这可以通过简单地将下面的行添加到第一个 sub 中来完成。

    Dim k
    k = Application.InputBox("Please select where to place the import.")
    On Error GoTo Term 'If k is not a range, go to Term
    Range(k).Activate
    Exit Sub

    Term:
    End

【讨论】：