0

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

类型;帐号：银行参考；受益人名称；日期；收益帐号； Bene IFSC; BENE BANK NAME;参考; Bene Mail ID IMPS; 45605104698; 45605104698; 60062000057200; ABCDEF; ABCDEF; 12122016; 0000000001.00; 0000000001.00; 10304060176; STREK0002022018; STERK0002018; STERK0002018; STERTBANK; STEAST BANK;印度 ;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文件如下：-

需要插入数据的 Excel 文件

4

1 回答 1

-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

祝你好运，

于 2021-02-06T13:44:31.687 回答