Excel 2016 宏将制表符分隔的 txt 文件导入到运行宏的工作簿中的特定工作表中？

这是一个修改代码的示例，它允许选择不同的文件，并将它们写入活动工作簿中的工作表。

我使用 CSV 文件进行测试，但是：

• 目的地是硬编码的，您可能想要更改它。
• 您需要根据您的要求将分隔符从comma我用于测试的分隔符更改为tab
• 您需要TextFileColumnDataTypes根据您的要求更改阵列。
• 如果您希望目标是运行宏的工作表，则只需更改Set rDest = …为 Set rDest = ActiveSheet.Cells(row,column)

Sub importText()
    Dim FName
    Dim rDest As Range
    Dim Answer As VbMsgBoxResult
    Dim fDialog As FileDialog, result As Integer
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
    
'Optional: FileDialog properties
    fDialog.AllowMultiSelect = False
    fDialog.Title = "Select a file"
    fDialog.InitialFileName = "F:\"
    
'Optional: Add filters
    fDialog.Filters.Clear
    fDialog.Filters.Add "Text/CSV files (*.txt; *.csv)", "*.txt; *.csv", 1
    
    Answer = MsgBox("Are You Sure You Want To Import A Text File?", vbYesNo + vbCritical, "Import A Text File")
    If Answer = vbYes Then
        Application.ScreenUpdating = False
    Else
        Exit Sub
    End If
    
    FName = Application.GetOpenFilename(filefilter:="Text/CSV files (*.txt; *.csv),*.txt;*.csv", MultiSelect:=False)
    If FName = False Then Exit Sub
    
    Set rDest = Worksheets("sheet2").Cells(1, 1)
   
    With rDest.Worksheet.QueryTables.Add(Connection:= _
        "TEXT;" & FName, Destination:=rDest)
        .Name = "new 1_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 4, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

这个 VBA 宏解决了这个问题。

 Sub ImportTXTFile()

  Dim vPath As Variant
  Dim wb As Excel.Workbook
  Dim ws As Excel.Worksheet
  Dim rng As Range, TextLine As String
  Dim rw As Long, col As Long
  Dim i As Long, j As Long, ary() As String, a As Variant

  Set wb = Excel.ActiveWorkbook

  vPath = Application.GetOpenFilename("TXT (Comma Separated) (*.Txt),*.Txt" _
     , 1, "Select the file", , False)
     
  MsgBox vPath
  
  Set rng = Application.InputBox(Prompt:="Pick the Sheet & a Cell", Type:=8)
  rng.Parent.Parent.Activate
  rng.Parent.Activate
  rw = rng(1).Row
  col = rng(1).Column

  Close #1
  i = rw
  Open vPath For Input As #1
  Do While Not EOF(1)
     Line Input #1, TextLine
     ary = Split(TextLine, ",")
     j = col
     For Each a In ary
        Cells(i, j).Value = a
        j = j + 1
     Next a
     i = i + 1
  Loop
  Close 1

 End Sub

这个怎么运作：

• 运行宏，显示文件选择器。
• 选择文本文件。
• 宏显示带有路径的文件，以 Ok 结束。
• 它提示选择工作表和单元格以粘贴导入的数据。

注意

• 在此代码(*.Txt),*.Txt"中它也应该是可编辑的*.CSV。

• 将工作簿另存为已启用宏。

我制作了一个类似的宏，可以在单个操作中读取文件，并且它还在将项目放入单元格之前清理数据：

Sub RoundedRectangle1_Click()
    Dim Ret
    Ret = Application.GetOpenFilename("Text Files (*.txt),*.txt")
    If Ret <> False Then
        readFile (Ret)
    End If
End Sub

Sub readFile(fname)
    Dim MyData As String, strData() As String, tabData() As String

    Open fname For Binary As #1
    MyData = Space$(LOF(1))
    Get #1, , MyData
    Close #1

    MyData = Replace(MyData, vbTab + vbTab, vbTab)

    strData() = Split(MyData, vbLf)
    For Row = 1 To UBound(strData) + 1
        tabData() = Split(strData(Row - 1), vbTab)
        For Column = 1 To UBound(tabData) + 1
            cellStr = Trim(tabData(Column - 1))
            If (Not cellStr = vbNullString) Then
                Cells(Row, Column) = cellStr
            End If 
        Next
    Next
End Sub

笔记

• 此代码将覆盖电子表格中的许多现有单元格，因此请注意
• 我用单个选项卡替换了双选项卡，这解决了我的单元格放置问题。您可能需要更复杂的替代品
• 双回路极限是根据经验得出的
• 我必须对 windows txt 文件使用 vbLf，对 mac txt 文件使用 vbNl
• 此代码从 1,1 开始放置单元格，但您可以更改它以满足您的需要

您可以阅读我在我的网站上为我的开源项目编写的文章形式的此信息：https ://www.virtualtwigs.com/articles/excel_macro_import_tab_delim_txt_article