0

事前に感謝します。抽出して Excel の各列に配置する必要があるデータを含む .txt ファイルがあります。私はVBAコーディングに非常に慣れておらず、多くのことを試しましたが、これを機能させるのに苦労しています...以下はこれまでのコードを示していますが、実行すると動作が異なります。実際には、データは Excel のサンプルとしてそれぞれのフィールドに配置する必要があります。Excelファイルでは、データを取得してそれぞれの見出しの列に入力する方法として、データを既に保持しています。

タイプ;勘定番号:銀行参照;受益者名;日付;日付;金額;金額勘定番号;ベネ・バンク名;参照;ベネ・メールID IMPS; 45605104698; 60062000057200; ABCDEF; 12122016; 0000000001.00; 10304060176; STRK0002018; 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 ファイルは次のとおりです。

データを挿入する必要がある Excel ファイル

4

1 に答える 1