Public Sub getstr()
Dim fn As Integer
Dim buf As Variant
Dim idx As Long
Dim ary As Variant
'CSVファイルからデータを取り出す
fn = FreeFile
Open ThisWorkbook.Path & "\" & "sample.csv" For Input As
#fn
Line Input #fn, buf
Close #fn
'comma区切りのデータを取り出す
ary = SplitByComma(buf)
'表示
buf = "-----" & vbCrLf
For idx = 0 To UBound(ary)
buf = buf & ary(idx) & vbCrLf
Next idx
buf = buf & "-----"
MsgBox buf, vbOKOnly + vbInformation, ""
End Sub
Public Function SplitByComma(strbuf As Variant) As Variant
'‥,"文字列",数値,‥ のように、各データが、
'文字列は["]で囲まれ、数値はそのままの形で[,]により
'区切られているCSVファイルで、
'文字列の中に[,]を含んでいるかもしれないとき、
'各データを配列に入れて返す
Dim buf As Variant
Dim idx As Long
Dim tmp As Variant
Dim pos As Long
Dim strnum As Long
strnum = Len(strbuf)
idx = 1
buf = ""
Do Until idx > strnum
tmp = Mid(strbuf, idx, 1)
If tmp = Chr(34) Then '
'先頭が " だったら、次の ", を探す
pos = InStr(idx, strbuf, Chr(34) &
Chr(44), vbTextCompare) ' ",
If pos > 0 Then
'見つかったら、その前までをとり出す
''''' tmp = Mid(strbuf, idx +
1, pos - 1 - idx)
''''' idx = pos + Len(Chr(34)
& Chr(44))
If pos = idx Then 'Chr(44)が先頭にある
'次の ", を探す
pos = InStr(idx + 1, strbuf, Chr(34) & Chr(44), vbTextCompare) ' ",
If pos > 0 Then
tmp = Mid(strbuf, idx + 1, pos - 1 - idx)
idx = pos + Len(Chr(34) & Chr(44))
Else
'見つからなかったら最後のひとつ前までを取り出す
' ← 最後は " のはずなので
tmp = Mid(strbuf, idx + 1, Len(strbuf) - idx - 1)
idx = Len(strbuf) + 1
End If
Else
tmp = Mid(strbuf, idx + 1, pos - 1 - idx)
idx = pos + Len(Chr(34) & Chr(44))
End If
Else
'見つからなかったら最後のひとつ前までを取り出す
' ← 最後は " のはずなので
tmp = Mid(strbuf, idx + 1,
Len(strbuf) - idx - 1)
idx = Len(strbuf) + 1
End If
Else
pos = InStr(idx, strbuf, Chr(44),
vbTextCompare) ' ",
If pos > 0 Then
'見つかったら、その前までをとり出す
tmp = Mid(strbuf, idx, pos -
idx)
idx = pos + Len(Chr(44))
Else
'見つからなかったら最後までを取り出す
tmp = Mid(strbuf, idx)
idx = Len(strbuf) + 1
End If
End If
buf = buf & tmp & vbTab '出力用文字列に格納。タブで連結する。
'普通は手入力時に文字としてtabは使わないですが、
'たとえば、
'Excelシートで、1行をコピーし、テキストエディタの画面に貼り付けると、
'セルのデータがタブで区切られて貼りつけられます。
'こんなデータには、適用不可です。
’ただし、こんな時は単純にtabで切り出すだけでデータを取り出せます。
DoEvents
Loop
'配列に入れて返す
SplitByComma = Split(Left(buf, Len(buf) - 1), vbTab, ,
vbTextCompare)
End Function