Excel VBA質問箱 IV

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

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


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

5977 / 76735

←次へ　｜　前へ→


	【76362】CSVデータ読み込み

あこ - 14/11/6(木) 20:34 -


	引用なし

	パスワード

質問です。

現在，以下のような記述をエクセル上のボタンに登録しています。
ボタンを押すと，デスクトップ上の任意のCSVファイルの選択を行い，CSVファイルを選択し，そのCSVデータを全てエクセル上のデータとして落としさせたいと思っています。

しかし，csvファイルによっては，
「実行時エラー　
アプリケーション定義またはオブジェクト定義のエラーです。」と出て，
「デバック（D）」ボタンを押すと，下から４行目の
「Cells(i, j) = strCell」のところが，黄色くエラーとして表示されてしまいます。

下記の記述もネット上で皆さんに教えていただきながらなんとかやっているもので，正直自分自身でよく理解できていませんが，上記のようなエラーを回避する方法をどなたかご教示いただけないかと思います。

どうかよろしくお願いいたします。

Sub Macro5()
Dim varFileName As Variant
Dim intFree As Integer
Dim strRec As String
Dim strSplit() As String
Dim i As Long, j As Long, k As Long
Dim lngQuate As Long
Dim strCell As String

varFileName = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv", _
Title:="CSVファイルの選択")
If varFileName = False Then
Exit Sub
End If

intFree = FreeFile '空番号を取得
Open varFileName For Input As #intFree 'CSVファィルをオープン

i = 0
Do Until EOF(intFree)
Line Input #intFree, strRec '1行読み込み
i = i + 1
j = 0
lngQuate = 0
strCell = ""
For k = 1 To Len(strRec)
Select Case Mid(strRec, k, 1)
Case "," '「"」が偶数なら区切り、奇数ならただの文字
If lngQuate Mod 2 = 0 Then
Call PutCell(i, j, strCell, lngQuate)
Else
strCell = strCell & Mid(strRec, k, 1)
End If
Case """" '「"」のカウントをとる
lngQuate = lngQuate + 1
strCell = strCell & Mid(strRec, k, 1)
Case Else
strCell = strCell & Mid(strRec, k, 1)
End Select
Next
'最終列の処理
Call PutCell(i, j, strCell, lngQuate)
Loop
Close #intFree
End Sub

Sub PutCell(ByRef i As Long, ByRef j As Long, ByRef strCell As String, ByRef lngQuate As Long)
j = j + 1
'「""」を「"」で置換
strCell = Replace(strCell, """""", """")
'前後の「"」を削除
If Left(strCell, 1) = """" And Right(strCell, 1) = """" Then
strCell = Mid(strCell, 2, Len(strCell) - 2)
End If
Cells(i, j).value= strCell
strCell = ""
lngQuate = 0
End Sub

0 hits

▼

【76362】CSVデータ読み込み あこ 14/11/6(木) 20:34