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

Question

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

类型；帐号：银行参考；受益人姓名；日期；金额；BENE 帐号；BENE IFSC；BENE 银行名称；参考；BENE 邮件 ID IMPS;45605104698;60062000057200;ABCDEF;12122016;0000000001.00;10304060176;STRK0002018;印度国家银行;5110845;abce@gmail.com;

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

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, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 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, InStrRev(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文件如下：-

Answer 1

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

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, 1), ";")
            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
   

祝你好运，