dポイントプレゼントキャンペーン実施中!

現在,以下の記述でエクセル上にマクロ実行ボタンを作成しました。
任意のCSVファイルをエクセルに取り込み利用する目的です。

実行ボタンを押すと,「実行時エラー ファイルにこれ以上データがありません。」として,記述中の
「Input #intFF, X(1), X(2), X(3), X(4), X(5), X(6), X(7) ' (2)」
部分が黄色になって止まってしまいます。

エクセル画面上には,希望通りのデータが出力されているようなので,このエラーが表示されなければデータの取り込みとしては問題ないのですが・・・。
どのようにこのエラーを回避し処理すればよいかかが分かりません。

どなたかご教示いただければ幸いです。
どうかよろしくお願いいたします。

Sub Macro4()

' CSV形式テキストファイル(7カラム)読み込みサンプル
Const cnsTITLE = "テキストファイル読み込み処理"
Const cnsFILTER = "CSV形式ファイル (*.csv),*.csv,全てのファイル(*.*),*.*"
Dim xlAPP As Application ' Applicationオブジェクト
Dim intFF As Integer ' FreeFile値
Dim strFileName As String ' OPENするファイル名(フルパス)
Dim vntFileName As Variant ' ファイル名受取り用
Dim X(1 To 7) As Variant ' 読み込んだレコード内容 ' (1)
Dim GYO As Long ' 収容するセルの行
Dim lngREC As Long ' レコード件数カウンタ

' Applicationオブジェクト取得
Set xlAPP = Application
' 「ファイルを開く」のフォームでファイル名の指定を受ける
xlAPP.StatusBar = "読み込むファイル名を指定して下さい。"
vntFileName = xlAPP.GetOpenFilename(FileFilter:=cnsFILTER, _
Title:=cnsTITLE)
' キャンセルされた場合はFalseが返るので以降の処理は行なわない
If VarType(vntFileName) = vbBoolean Then Exit Sub
strFileName = vntFileName

' FreeFile値の取得(以降この値で入出力する)
intFF = FreeFile
' 指定ファイルをOPEN(入力モード)
Open strFileName For Input As #intFF
GYO = 1
' ファイルのEOF(End of File)まで繰り返す
Do Until EOF(intFF)
' レコード件数カウンタの加算
lngREC = lngREC + 1
xlAPP.StatusBar = "読み込み中です....(" & lngREC & "レコード目)"
' レコードを読み込む(このサンプルは7項目のCSV)
Input #intFF, X(1), X(2), X(3), X(4), X(5), X(6), X(7) ' (2)
' 行を加算しA~G列にレコード内容を表示(先頭は2行目)
GYO = GYO + 1
Range(Cells(GYO, 1), Cells(GYO, 7)).Value = X ' 配列渡し ' (3)
Loop
' 指定ファイルをCLOSE
Close #intFF
xlAPP.StatusBar = False
' 終了の表示
MsgBox "ファイル読み込みが完了しました。" & vbCr & _
"レコード件数=" & lngREC & "件", vbInformation, cnsTITLE
End Sub

A 回答 (5件)

> お恥ずかしい話ですが,記述は,ネットのものを参考にしたものでありあまり理解できていません。



ファイルの最後まで7個ずつデータを読み込んでおるわけですが、データが15個だった場合、最後に1個しかデータがないのに7個読もうとしてエラーになります。

> もし,可能でしたら具体的な記述をご教示いただけないかと思います。

CSVファイルの中身がどうなっているのかわからないので以下の変更で正しく動くかどうかは不明ですが

2番目に回答した
http://www.moug.net/tech/exvba/0060086.html
を参考にして Line Input を利用した例です。


Dim X(1 To 7) As Variant ' 読み込んだレコード内容 ' (1)
↓変更
Dim X As Variant ' 読み込んだレコード内容 ' (1)

追加
Dim buf As String

コードのこの部分を

レコードを読み込む(このサンプルは7項目のCSV)
Input #intFF, X(1), X(2), X(3), X(4), X(5), X(6), X(7) ' (2)
' 行を加算しA~G列にレコード内容を表示(先頭は2行目)
GYO = GYO + 1
Range(Cells(GYO, 1), Cells(GYO, 7)).Value = X ' 配列渡し ' (3)
Loop


以下に変更します。

' レコードを読み込む
Line Input #intFF, buf
X = Split(buf, ",")
' 行を加算しA~G列にレコード内容を表示(先頭は2行目)
GYO = GYO + 1
Range(Cells(GYO, 1), Cells(GYO, UBound(X) + 1)).Value = X ' 配列渡し ' (3)
Loop
ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
    • good
    • 0
この回答へのお礼

お礼が遅くなり申し訳ありません。
大変参考になりました。
処理もおかげさまでうまくいきました。
本当にありがとうございました。

お礼日時:2014/09/29 23:16

No3の具体例として



1,2,3,4,5,6,7
8,9,10,11,12,13,14
15

↑こんなデータの場合元のコードでエラーになります。

また

1,2,3,4,5,6,7
8,9,10,11,12,13,14
,15,,,,,

↑こんなデータの場合、元のコードだと最後の改行がないとエラーになります。No4さんと逆ですね。


1,2,3,4,5,6,7
8,9,10,11,12,13,14

↑こんなデータだと改行は関係なく元のコードでもエラーになりません。


ちなみに、どのデータでもNo3のコードに変更すればエラーにはなりません。ただし2013の結果です。
    • good
    • 0

私もこれは上手く処理できませんでした。



多分CSVの最後が改行されているのが原因
データ1,データ2,・・・,データ7(改行)
データ1,データ2,・・・,データ7(改行)
データ1,データ2,・・・,データ7(改行)
(先頭)
こういうふうになっているとエラーになります。

データ1,データ2,・・・,データ7(改行)
データ1,データ2,・・・,データ7(改行)
データ1,データ2,・・・,データ7    ←ここの改行をとるとうまくいく。
つまりデータ7の最後にEOFが来るようにしないといけません。

直すにはデータを直したほうが早いかも。

コードを直すとしたら、他の方のlineinputもいいけど、最後の行の処理をしないといけなくなります。

そうじゃなければファイの行を数えてその分までループさせるとかかな。

特に細かいことを気にしないなら、私がやっている方法ですがエラー時に飛ばしちゃう方法もあります。

Input #intFF, X(1), X(2), X(3), X(4), X(5), X(6), X(7) ' (2)
On Error GoTo ReadExit
' 行を加算しA~G列にレコード内容を表示(先頭は2行目)
GYO = GYO + 1
Range(Cells(GYO, 1), Cells(GYO, 7)).Value = X ' 配列渡し ' (3)
Loop

ReadExit:

' 指定ファイルをCLOSE
Close #intF
    • good
    • 0
この回答へのお礼

大変参考になりました。
処理も行うことができました。
大変感謝しています。

お礼日時:2014/09/29 23:15

No1です。



以下のページを参考にしてLine Input を利用してみてはいかがでしょう。
http://www.moug.net/tech/exvba/0060086.html
    • good
    • 0

コード自体は問題がないようですので、読み込むCSVファイルのデータが7の倍数じゃないのではないでしょうか。

この回答への補足

kkkkkm様
ご回答いただきありがとうございます。
お恥ずかしい話ですが,記述は,ネットのものを参考にしたものでありあまり理解できていません。
もし,可能でしたら具体的な記述をご教示いただけないかと思います。
わがままばかりで申し訳ありません。
どうかよろしくお願いいたします。

補足日時:2014/09/28 00:08
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!