| |
横から失礼します
列を抜き出して書き込むならこんなやり方も有るよ
Split関数を仕様しているので、Excel2000以降じゃないと使え無いけど
ただし、Excel97でもSplit関数の代替を作れば遅く成るけど可能
Split関数の代替は必要なら考えて見ます
>不規則な部分の項目(列)
と有りますが、これも条件が解れば組み込み可能かもしれません
Public Sub TextRead()
Dim i As Long
Dim vntFileName As Variant
Dim dfn As Integer
Dim strBuff As String
Dim vntColm As Variant
Dim vntData As Variant
Dim vntWrite As Variant
Dim lngWriteRow As Long
Const cstrFilter As String _
= "テキスト (*.txt),*.txt,CSV (*.csv),*.csv,全て (*.*),*.*"
Const cstrTitle As String = "読み込みファイルの選択"
'読み込む列の指定
vntColm = Array(15, 16, 42)
vntColm = Array(2, 4, 6)
'書き込み用配列の確保
ReDim vntWrite(UBound(vntColm))
'読み込むファイル名を指定
vntFileName _
= Application.GetOpenFilename(cstrFilter, 1, cstrTitle)
If vntFileName = False Then
Exit Sub
End If
'ファイルをInputモードで開く
dfn = FreeFile
Open CStr(vntFileName) For Input As dfn
'書き込み行の初期値を設定
lngWriteRow = 1
'ファイルの終わりまで繰り返し
Do Until EOF(dfn)
'１行（１レコード）読み込み
Line Input #dfn, strBuff
'区切文字(Tab)で文字列を区切配列に格納(列数と添え字が等しい)
vntData = Split(strBuff, vbTab, , vbBinaryCompare)
'読み込み列を書き込み用配列に代入
For i = 0 To UBound(vntColm)
vntWrite(i) = vntData(vntColm(i))
Next i
'書き込み位置にデータを書き込み
With Cells(lngWriteRow, 1)
Range(.Offset(, 0), .Offset(, _
UBound(vntColm))).Value = vntWrite
End With
'書き込み行を更新
lngWriteRow = lngWriteRow + 1
Loop
'ファイルを閉じる
Close #dfn
End Sub
|
|
- 03/3/28(金) 11:10 -
