| |
>カンマ区切りに囲まれた1項目の中に改行コードが入っているもの
以下のコードで読めると思います
>CSVファイルをEXCEL展開すると00001が1に変わってしまいます｡
の件に就いては、このコード中の様に、
読み込まれるセルの書式を文字列に設定しながら読み込むか､
若しくは、このコードではActiveSheetに読み込まれるので、
先に読み込まれる列の書式を文字列にすれば善いと思います
Option Explicit
Public Sub TextReadCsv()
Dim i As Long
Dim vntFileName As Variant
If Not GetReadFile(vntFileName, ThisWorkbook.Path) Then
Exit Sub
End If
CSVRead vntFileName, ActiveSheet, 1, 1, True, ","
End Sub
Private Sub CSVRead(ByVal strFileName As String, _
ByVal wksWrite As Worksheet, _
Optional ByRef lngRow As Long = 1, _
Optional ByRef lngCol As Long = 1, _
Optional ByRef blnHeader As Boolean = True, _
Optional strDelim As String = ",")
Dim dfn As Integer
Dim vntField As Variant
Dim strLine As String
Dim blnMulti As Boolean
Dim strRec As String
dfn = FreeFile
Open strFileName For Input As dfn
Do Until EOF(dfn)
Line Input #dfn, strLine
strRec = strRec & strLine
vntField = SplitCsv(strRec, strDelim, , , blnMulti)
If blnMulti Then
strRec = strRec & vbLf
Else
If blnHeader Then
With wksWrite.Cells(lngRow, lngCol)
'例えば、２番目のフィールドを文字列にする場合
.Offset(, 1).NumberFormatLocal = "@"
'1レコード出力
.Offset.Resize(, UBound(vntField) + 1) = vntField
End With
lngRow = lngRow + 1
End If
strRec = ""
blnHeader = True
End If
Loop
Close #dfn
End Sub
Public Function SplitCsv(ByVal strLine As String, _
Optional strDelimiter As String = ",", _
Optional strQuote As String = """", _
Optional strRet As String = vbCrLf, _
Optional blnMulti As Boolean) As Variant
' strLine :分割元と成る文字列
' strDelimiter :区切り文字
' SplitCsv :戻り値、切り出された文字配列
Dim lngDPos As Long
Dim vntData() As Variant
Dim lngStart As Long
Dim i As Long
Dim vntField As String
Dim lngLength As Long
'配列の添え字の初期値
i = 0
'Delimiter探索の開始位置
lngStart = 1
'分割元の文字列の長さ
lngLength = Len(strLine)
'複数行Flagを初期化
blnMulti = False
'探索開始位置が分割元の文字列の長さを超えるまで分割
Do
'配列を確保
ReDim Preserve vntData(i)
'もし、開始位置の文字がstrQuoteと違う場合
If Mid$(strLine, lngStart, 1) <> strQuote Then
'Delimiterの位置を取得
lngDPos = InStr(lngStart, strLine, _
strDelimiter, vbBinaryCompare)
'Delimiterがある場合
If lngDPos > 0 Then
'開始位置からDelimiterの前までを取得
vntField = Mid$(strLine, lngStart, _
lngDPos - lngStart)
'開始位置をDelimiterの後ろに更新
lngStart = lngDPos + 1
Else
'開始位置以降を取得
vntField = Mid$(strLine, lngStart)
'開始位置を分割元の文字列の長さを超える位置に
lngStart = lngLength + 1
End If
'開始位置の文字がstrQuoteと同じ場合
Else
'開始位置をstrQuoteの後ろに設定
lngStart = lngStart + 1
Do
'strQuoteの位置を取得
lngDPos = InStr(lngStart, strLine, _
strQuote, vbBinaryCompare)
'strQuoteがある場合
If lngDPos > 0 Then
'取得済みの文字列にstrQuote以降の文字列を加算
vntField = vntField & Mid$(strLine, _
lngStart, lngDPos - lngStart)
'開始位置をstrQuote以降に更新
lngStart = lngDPos + 1
'分割元の文字列の開始位置から１文字取得し
Select Case Mid$(strLine, lngStart, 1)
Case "" '空白の文字列なら
'Doを抜ける
Exit Do
Case strDelimiter 'Delimiterなら
'開始位置を１つ進める
lngStart = lngStart + 1
'Doを抜ける
Exit Do
Case strQuote 'strQuoteなら
'開始位置を１つ進める
lngStart = lngStart + 1
'取得済みの文字列にstrQuoteを加算
vntField = vntField & strQuote
End Select
'strQuoteが無い場合
Else
'複数行Flagを立てる
blnMulti = True
vntField = Mid$(strLine, lngStart) & strRet
'開始位置を分割元の文字列の長さを超える位置に
lngStart = lngLength + 1
'Doを抜ける
Exit Do
End If
Loop
End If
'配列に取得文字列を代入
vntData(i) = vntField
'取得文字列を初期化
vntField = ""
'配列の添え字を更新
i = i + 1
Loop Until lngLength < lngStart
SplitCsv = vntData()
End Function
Private Function GetReadFile(vntFileNames As Variant, _
Optional strFilePath As String, _
Optional blnMultiSel As Boolean = False) As Boolean
Dim strFilter As String
'フィルタ文字列を作成
strFilter = "CSV File (*.csv),*.csv," _
& "Text File (*.txt),*.txt," _
& "CSV and Text (*.csv; *.txt),*.csv;*.txt," _
& "全て (*.*),*.*"
'読み込むファイルの有るフォルダを指定
If strFilePath <> "" Then
'ファイルを開くダイアログ表示ホルダに移動
ChDrive Left(strFilePath, 1)
ChDir strFilePath
End If
'もし、ディフォルトのファイル名が有る場合
If vntFileNames <> "" Then
SendKeys vntFileNames, False
End If
'ファイルを開くダイアログを表示
vntFileNames _
= Application.GetOpenFilename(strFilter, 1, , , blnMultiSel)
If VarType(vntFileNames) = vbBoolean Then
Exit Function
End If
GetReadFile = True
End Function
|
|
Hirofumi
- 04/9/3(金) 21:14 -
