☰

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

tag-icon • tag-icon microsoft-excel vba macros
Excel 2016 宏将制表符分隔的 txt 文件导入到运行宏的工作簿中的特定工作表中？

Excel 2016

你好

我有一个名为“Project”的工作簿，其中有一个名为“Imported_Text”的工作表。

通过网上资源以及我自己有限的知识，我（克服困难）制作了一个子程序（宏），它将打开用户选择的制表符分隔的 txt 文件，仅选择我需要的列，然后 excel 将其放在工作表中。一切都运行正常，但是，Excel 总是创建一个新的工作簿并将导入的数据放在其中，而我并不需要这些数据。

我需要能够从“项目”工作运行子宏，并将导入的数据放入现有的“Imported_Text”工作表中，但我无法弄清楚如何操作。

我知道我可以录制一个宏，执行导入文本文件，并在宏仍在录制时手动选择并复制新工作表中的数据，将其粘贴到我的“Imported_Text”工作表中，保存我的“Project”工作簿，关闭但不保存 Excel 创建的新工作簿并停止宏录制。这将为我提供实现目标的 VBA 代码，但这似乎是一种相当复杂的做事方式。

也许有谁能建议更好的方法吗？

例如，在将结果写入新文件并粘贴到我选择的工作表之前，是否可以捕获数组的结果（到剪贴板？）？

这是我的代码 - 虽然不够优雅，但是可以工作，

Sub ImportTXT()
    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"

    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

    FName = Application.GetOpenFilename()

' ImportTXT code copied from Macro recording
        Workbooks.OpenText FileName:=FName, Origin:=xlWindows, 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, 9), Array(8 _
        , 9), Array(9, 9), Array(10, 1), Array(11, 9), Array(12, 9), Array(13, 9), Array(14, 9), _
        Array(15, 9), Array(16, 9), Array(17, 9), Array(18, 9), Array(19, 9), Array(20, 9), Array( _
        21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 9)), TrailingMinusNumbers _
        :=True
    
    End If
End Sub

答案1

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

我使用 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

答案2

这个 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

怎么运行的：

  • 运行宏，显示文件选择器。
  • 选择文本文件。
  • 宏显示带有路径的文件，单击“确定”完成。
  • 它提示选择工作表和单元格来粘贴导入的数据。

注意：

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

  • 将工作簿保存为启用宏。

答案3

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

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

相关内容