Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

42434 / 76735

←次へ　｜　前へ→


	【39370】ＣＳＶファイルの読み込み

質問 - 06/6/22(木) 18:00 -


	引用なし

	パスワード

　ＣＳＶファイルの読み込み処理を行いＥＸＣＥＬに表示する処理を
　Ｗｅｂで捜して処理すると、うまく行くケースと行かないケースが
　あるので教えて下さい。

　大変参考にはなりました。

　現象）

　２件の明細を読み込むと１行の内容として表示してしまう。
　各明細の最後に改行マークはある。
　データは""で囲まれている。
　但し明細最後のカンマはない。
　
　以上教えて下さい。

Option Explicit

' CSV形式テキストファイル(不定カラム)読み込みサンプル
Sub READ_TextFile()
　　Const cnsTITLE = "テキストファイル読み込み処理"
　　Const cnsFILTER = "全てのファイル (*.*),*.*"
　　Dim xlAPP As Application　　　　' Applicationオブジェクト
　　Dim intFF As Integer　　　　　　' FreeFile値
　　Dim strFILENAME As String　　　 ' OPENするファイル名(フルパス)
　　Dim X() As Variant　　　　　　　' 読み込んだレコード内容
　　Dim IX1 As Long　　　　　　　　 ' CSV項目カラムINDEX
　　Dim GYO As Long　　　　　　　　 ' 収容するセルの行
　　Dim lngREC As Long　　　　　　　' レコード件数カウンタ
　　Dim strREC As String　　　　　　' レコード領域
　　Dim POS1 As Long　　　　　　　　' レコード文字位置INDEX
　　Dim POS2 As Long　　　　　　　　' レコード文字位置INDEX

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

　　' 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 & "レコード目)"
　　　　' 行単位にレコードを読み込む
　　　　Line Input #intFF, strREC　　　　　　　　　　　　　　　　　　　' 1.

　　　　' LineInputより自分で半角カンマを探しCSV→項目分割させる
　　　　POS1 = 1
　　　　IX1 = 0
　　　　ReDim X(IX1)　　　　　　　　' 配列を初期化
　　　　Do While POS1 <= Len(strREC)　　　　　　　　　　　　　　　　　 ' 2.
　　　　　　POS2 = InStr(POS1, strREC, ",", vbTextCompare)　　　　　　 ' 3.
　　　　　　If POS2 < POS1 Then
　　　　　　　　POS2 = Len(strREC) + 1
　　　　　　End If
　　　　　　ReDim Preserve X(IX1)　 ' 配列要素数を再設定
　　　　　　X(IX1) = Trim$(Mid$(strREC, POS1, POS2 - POS1))　　　　　　' 4.
　　　　　　' シングルコーテーション、ダブルコーテーションで囲まれている場合は
　　　　　　' 両端文字を取り除く
　　　　　　If (((Left$(X(IX1), 1) = """") And (Right$(X(IX1), 1) = """")) Or _
　　　　　　　　((Left$(X(IX1), 1) = "'") And (Right$(X(IX1), 1) = "'"))) Then　' 5.
　　　　　　　　X(IX1) = Trim$(Mid$(X(IX1), 2, Len(X(IX1)) - 2))
　　　　　　End If
　　　　　　POS1 = POS2 + 1
　　　　　　IX1 = IX1 + 1
　　　　Loop

　　　　' 行を加算しレコード内容を表示(先頭は2行目)
　　　　GYO = GYO + 1
　　　　If IX1 >= 1 Then
　　　　　　Range(Cells(GYO, 1), Cells(GYO, IX1)).Value = X　 ' 配列渡し 6.
　　　　End If
　　Loop
　　' 指定ファイルをCLOSE
　　Close #intFF
　　xlAPP.StatusBar = False
　　' 終了の表示
　　MsgBox "ファイル読み込みが完了しました。" & vbCr & _
　　　　"レコード件数=" & lngREC & "件", vbInformation, cnsTITLE
End Sub

0 hits

▼

【39370】ＣＳＶファイルの読み込み 質問 06/6/22(木) 18:00

≪