将文本文件中的数据插入到相应的 excel 列中

问题描述

非常感谢提前 我有一个 .txt 文件，其中包含需要提取并放入 Excel 中相应列的数据。我对 VBA 编码非常陌生，并尝试了很多，但很难完成这项工作......下面显示了我迄今为止的代码，但在运行时，它的工作方式有所不同。实际上数据需要放在各自的字段中作为excel中的示例。在 Excel 文件中，我已经将数据保留为如何获取和填写相应的标题列。

类型；帐号：银行参考号；收款人姓名；日期；金额；BENE 帐号；BENE IFSC；BENE 银行名称；参考；BENE 邮箱 ID IMPS;45605104698 ;60062000057200 ;ABCDEF ;12122016;0000000001.00;10304060176 ;STRK0002018;印度国家银行;51108@5110

我用来提取上述数据并将其放入各自列的代码如下：-

Option Explicit

Sub importTXT()
Dim r As Range,myfile As Variant
Dim qt As QueryTable,i As Integer
Dim del As Range

'where myfile needs to select manually
myfile = Application.GetopenFilename("All Files (*.*),**.*",_,"Select TXT file",False)
If myfile = False Then Exit Sub

'elseif its fixed
'myfile = "D:\sample student file"

Application.ScreenUpdating = False

With ActiveSheet
.Range("E7").CurrentRegion.Cells.Clear
With .QueryTables.Add(Connection:="TEXT;" & myfile,Destination:=.Range("$E$7"))
        .Name = "MST"
        .TextFilePlatform = 437
        .TextFileStartRow = 2
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileTabDelimiter = True
        .TextFileColumnDataTypes = Array(1,1,1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
'delete query tables if found any.
    For Each qt In ActiveSheet.QueryTables
        qt.Delete
    Next qt
'Delete the Data Connections
If .Parent.Connections.Count > 0 Then
    For i = 1 To .Parent.Connections.Count
        .Parent.Connections.Item(i).Delete
    Next i
End If

For Each r In .Range("E7:X" & .UsedRange.Rows.Count)
    If InStr(r,"Title = ") > 0 Then
        r.Offset(,1) = Mid(r.Value,InStr(r," ") + 8,InStrRev(r.Value," "))
        r.Offset(,2) = Mid(r.Value," ") + 2,Len(r.Value) - InStrRev(r.Value," ") - 2)
    Else
        If del Is nothing Then
            Set del = r
        Else
            Set del = Union(del,r)
        End If
    End If
Next
End With
Application.ScreenUpdating = False
End Sub

需要插入数据的示例excel文件如下：-

解决方法

我使用了不同的方法，但我认为这可以满足您的需求：

1. 导入 CSV

2. 存储在数组中

3. 使用基于映射数组的新列设置数组

4. 粘贴到工作表

    Sub ImportCsv()
        'load the source file based on user input to an array
        Dim filename As String,Data
        filename = Application.GetOpenFilename
        Data = openfile(filename)
   
        'spitting first line to get nr of columns
        Dim cls,Data2,j As Long,i As Long,newcls
        cls = Split(Data(1,1),";")
   
        'Re-Order columns - You can just change to nr according to your mapping => first column mapped to col 5 etc...
        newcls = Array(5,3,10,14,8,6,13,19,18,9,22)
   
        'Setup reformated array,make sure the Ubound of columns corresponds to the max col in your mapping
        ReDim Data2(1 To UBound(Data),1 To 22)
        For j = 1 To UBound(Data,1)
            cls = Split(Data(j,";")
            For i = 1 To UBound(cls)
                Data2(j,newcls(i)) = Trim(cls(i - 1))
            Next i
        Next j
   
        'paste to sheet
        Worksheets("Sheet1").Range("A1").Resize(UBound(Data2),UBound(Data2,2)).Value2 = Data2
    End Sub
   
    Private Function openfile(filename As String) As Variant
        'import External
        Dim wbExt As Workbook,Data,FilePath As String
        'FilePath = Application.ActiveWorkbook.Path & filename => alternative if you just ask a filename to the user. this will set the path.
        Set wbExt = Workbooks.Open(filename:=filename) 'replace filename with filepath if you choose above approach
        With wbExt: Data = .Sheets(1).UsedRange.Value: .Close: End With 'get data from source and close
        openfile = Data 'send array back to main sub
    End Function
   

祝你好运，