[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『VBAで固定長テキストファイルのエクセル読み込み』（yui）
現在VBAの勉強をしている初心者です。
ネットで調べてつなぎ合わせたりしてなんとかVBAを作成しています。
今回、作成するよう業務で指示を受けたのですが、どのように作成してよいかわからず皆さまにお力をお貸し頂ければと思質問させていただきます。
かなり丸投げのようになってしまい申し訳ありません。
OSはXPで、エクセル2003を使用しています。
作成したいものは（指示されているものは)、
・固定長テキストファイルをエクセルに設定したボタン一つで取り込み出来るものを作成したい。
・エクセルには、列A1セルから最大、最終列まで横に数字が入ります(セルの開始位置は変わるかもしれません)。テキストファイルを読み込んだ時にはその列に記載してある数字で区切ってすぐ下のB列に順に読みこんでいきたいのです。
・テキストファイルは改行で区切られている場合がありますが、そのテキストファイル内の一行をエクセルの一行に読み込み、もしテキストファイルに2行目や3行目があれば同じくA1の行の数値で区切って、2行目はC1から始まる行へ、3行目はD1から始まる行へと区切っていきたいです。
・テキストファイルには、半角スペースも入っているので、半角スペースも1として区切る。
・エクセルファイルに入れる区切る数値は都度変えたい。
例
テキストファイル(半角スペースは*で表示させていただきます)
a1bbbb***234CCCCCCCCCCC*TTT改行
cccccccccc***234
上記ですと、
下記のようなエクセルファイルに設置したボタンを押すとテキストファイルを自動で取り込み、
VBA前
A1| A2| A3| A4| A5|A6|A7|A8| 1 3 | 1 | 4 | 3 | 6 |4 |1 |10| 2 | | | | | | | | 3 4
VBA起動後は
A1 |A2|A3 | A4| A5 |A6 |A7|A8 | 1 3 |1 |4 | 3 | 6 |4 |1 |4 | 2 a1b|b |bb**|*23|4CCCCC|CCCC|C |*TTT| 3 ccc|c |cccc|cc3|XX234 | | | | 4
というようにしたいです。
実は、この逆のVBA起動後の状態から、逆にテキストファイルに出力するコードも作成しなければならないのですがとりあえずテキスト入力が完成しないとどうにもならないのでまずは入力のコードに取り掛かっています。
マクロの自動記録でコードをみてみたのですが、arrayと記載がある部分を変えるように思ったのですが、今回はエクセルに記載の数値で区切るのでどう変更していいかもわからず・・。
お力をお借りしたいと思った次第です。
ちなみに、ネットなどで調べてテキストファイルを取り込むマクロは下記のように記載してみました。
sub ファイル読み込み
Dim defaultfolder As string
Dim ch As integer
Dim txtStr As string
Dim str() As string
Dim i As integer
Dim openfile As string
defaultfolder="c:\指定フォルダ"
ChDrive defaultfolder
ChDir defaultfolder
defaultfolder=Application.GetOpenFilename("txtファイル,*.txt")
ch=FreeFile
open defaultfolder For input As #ch
i=2
Do While Not EOF(1)
Line Input #ch, txtStr
★str=Split(tXtStr,",")
Range(cells(i,1),Cells(i,UBound(str) +1)=str
i= i+1
Loop
Close #ch
End sub
上記のコードは、カンマ区切りで読み込むコードなので今回の仕様に合わせて、エクセルファイルの一行目を見てその数値で区切るためには★の部分を何か指定するのかなと思い考えているのですがさっぱりわかりません。
マクロの記録だと全く違うコードが出てきますので、上記で記載したコードではそもそも使えないのでしょうか？
もともとはCSVを取り込むコードでしたが、テキストファイルに変えてみました・・。
どなかた助けていただけませんでしょうか？
私も固定長データというものを指示されて初めて見たのでおそらく説明不足は多々あるかと思います。（そもそも固定長というのも、今回ネットで検索してそれに当てはまるということを知った次第です)
説明不足は都度確認し追記させていただきますので、どうかお助け下さいませんでしょうか。
宜しくお願い致します。
行列の表現が逆です。
普通は、
A |B |C | D | E |F |G |H | 1 3 |1 |4 | 3 | 6 |4 |1 |4 | 2 a1b|b |bb**|*23|4CCCCC|CCCC|C |*TTT| 3 ccc|c |cccc|cc3|XX234 | | | |
列はA〜H〜
行は1〜3〜
です。
固定長の場合、普通は各項目のデータ種別も指定します。
１行目に項目長、３行目にデータ種別（テキスト形式、一般形式、数値、日付、削除等）を指定します。
２行目は各項目の先頭のカラム位置を算出するので空白行とします。
OpenTextのヘルプを見るとFieldInfoのデータ種別が分かります。
|A |B |C | D | E |F |G |H | 1 |3 |1 |4 | 3 | 6 |4 |1 |4 | 2 | | | | | | | | | 3 |2 |2 |1 |2 | 1 |2 |2 |2 |
Sub 固定長読み込み()
Dim Tx As Workbook
Dim AR As Variant
Dim Sh As Worksheet
Dim f As Variant
f = Application.GetOpenFilename("固定長ファイル,*.*")
If VarType(f) = vbBoolean Then Exit Sub
Set Sh = ActiveSheet
With Sh
.UsedRange.Offset(3).ClearContents
.Range("A2").Value = 0
With .Range("B2", .Range("A1").End(xlToRight).Offset(1))
.Formula = "=A2+A1"
.Value = .Value
End With
AR = WorksheetFunction.Transpose( _
.Range("A2", .Range("A1").End(xlToRight).Offset(2)).Value)
End With
Workbooks.OpenText FileName:=f, StartRow:=1, _
DataType:=xlFixedWidth, FieldInfo:=AR
Set Tx = ActiveWorkbook
Tx.Worksheets(1).UsedRange.Copy Sh.Range("A4")
Tx.Close False
End Sub
（ウッシ）
その前に
他のかたからレスが有るかも。
(ウッシ)
コードを教えて頂きまして本当にありがとうございました。
大変助かります。
こういうコードになるのですね。
勉強して理解していきたいです。
また、行と列がめちゃくちゃな例を記載して申し訳ありませんでした。
今改めてみますと本当にお恥ずかしいミスでした。。
頂いたコードについて、さらに教えて頂いても宜しいでしょうか？
コードは動きましたが、私の仕様説明が不足している部分がありましたので、
そこの部分でお力添え頂けませんでしょうか。
質問１．
＞固定長の場合、普通は各項目のデータ種別も指定します。
＞１行目に項目長、３行目にデータ種別（テキスト形式、一般形式、数値、日付、削除等）を指定します。
＞２行目は各項目の先頭のカラム位置を算出するので空白行とします。
→教えていただいてありがとうございました。
教えて頂いたように、指定してみました。
が、例えばスペース（ここでは「*」で表現しました)を一つの長さ？として認識してセルに切り分けてくれるのですが項目長4と指定して、そこに「**33」と入った場合に、セルの見た目は「33」となりますが、クリックなどしても33の前にカーソルを合わせてもスペースは入っていない状態です。
この場合、元のデータと突き合わせをしないとこのセルに「**33」か「33**」か「*33*」か分かりません。
データの種別をテキスト形式（文字列？）の「2」を指定してみましたが、このスペースはカーソルを合わせて判別出来るように出来ませんでしょうか？
例えば、普通のエクセルファイルでセルの表示形式を「文字列」にして**33と打つと**の部分もカーソルで動きスペースが認識出来るのですが。
データ種別を2にしたら文字列となり、このように取り込み出来るかと思ったのですが出来ませんでした。取り込み前にセルの形式を変えてみてもダメでした。
何か対応方法があればご教授頂けませんでしょうか？
質問２
私の仕様お願い不足で申し訳ございません。。
実は、1行目の項目長以上にデータが入っていた場合に、それ以降を切り捨てすることはできませんでしょうか？
よくよく依頼者に確認したところ、テキストデータ全ての情報を使わず、ある程度のデータまでしか見ないことがあるとのこと。
現在では、項目長以上のデータは最後の指定項目長が「4」であったとしてもまだ後ろにデータがあった場合にその最後の4の部分に残り全てのデータが入ってくるようです。
|A |B |C | 1 |3 |1 |4 | 2 |省略 | 3 |2 |2 |1 | 4 |a1b|b |bb***234CCCCCCCCCC*TTT |←この状態ですが、「bb**」以降は切り捨てたい
大幅な変更が必要なようでしたら本当に申し訳ございませんが、ご教授頂けますと助かります。
宜しくお願い致します。
(yui)
１行目に項目長、３行目にデータ種別（テキスト形式、一般形式、数値、日付、削除等）を指定します。
２行目は各項目の先頭のカラム位置を算出して入力して下さい。
１行目の項目長指定セルから1セル以上離れたセルに1レコードのレコード長をセットして下さい。
インプットボックスで聞き取りしますけど、キャンセルした場合にこのセルの値を使います。
a1bbbb***234CCCCCCCCCC*TTT このデータの
1カラム目の3桁、4カラム目の1桁、8カラム目の4桁を取得する場合、
|A |B |C |D |E 1 |3 |1 |4 | |180 2 |1 |4 |8 3 |2 |2 |2
と指定します。
必要な部分だけ取り込み、指定しない部分は取り込みません。
Sub 固定長読み込み1()
Dim lstCol As Long
Dim setSh As Worksheet
Dim i As Long
Dim j As Long
Dim FNo As Long
Dim tLen As Long
Dim f As Variant
Dim r As Range
Dim v() As Byte
Dim h As Long
f = Application.GetOpenFilename("固定長ファイル,*.*")
If VarType(f) = vbBoolean Then Exit Sub
Set setSh = ActiveSheet
With Application
tLen = .InputBox("1レコードのレコード長を入力して下さい。" & vbCrLf & _
"未入力or０の場合は1行目の最右端のセルの値" & vbCrLf & _
"を採用します。", Type:=1)
If tLen = 0 Then
tLen = .Cells(1, Columns.Count).End(xlToLeft).Value
End If
.ScreenUpdating = False
With setSh
.UsedRange.Offset(3).ClearContents
'レコード長
lstCol = .Range("A1").End(xlToRight).Column
'データ種別（書式設定)
For Each r In .Range("A3", .Range("A3").End(xlToRight))
Select Case r.Value
Case 2: r.EntireColumn.NumberFormatLocal = "@"
Case 5: r.EntireColumn.NumberFormatLocal = "yyyy/m/d"
Case Else: r.EntireColumn.NumberFormatLocal = "G/標準"
End Select
Next
FNo = FreeFile
Open f For Binary Access Read As #FNo
If -Int(-LOF(FNo) / tLen) = FileLen(f) / tLen Then
'読み込み開始行
i = 1
ReDim v(1 To tLen)
h = 1
For i = 1 To -Int(-LOF(FNo) / tLen)
Get #FNo, h, v
'フィールドData作成
For j = 1 To lstCol
.Cells(i + 3, j) = Mid(StrConv(v, vbUnicode), .Cells(2, j), .Cells(1, j))
Next
h = h + tLen
Next i
Close #FNo
Else
MsgBox "1レコードのレコード長が不正です。", vbExclamation
End If
End With
.ScreenUpdating = True
End With
End Sub
（ウッシ）
お返事ありがとうございます。
また、コードを教えて頂きまして本当にありがとうございました。
まだ動きを試せていないので、明日以降試していきたいです。
まずはいただいたコードをじっくり見て、どういう仕組みかを理解したいです。
自分で編集できるようにしないとです！
また何か問題や不明点が発生しましたらご相談させていただいてしまうかもしれませんが
その際はどうぞ宜しくお願い致します。
本当にありがとうございました。
(yui)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.