将文本文件导入主excel文档（VBA）？

Question

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

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

有什么办法可以改变它，所以我不必指定'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 

Answer 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 

第二子，进口一行行（W/O在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 

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

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