| |
質問です。
現在，以下のような記述をエクセル上のボタンに登録しています。
ボタンを押すと，デスクトップ上の任意の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
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
