事前に感謝します。抽出して 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 ファイルは次のとおりです。