|
▼なな さん:
>CSVを読取モードで開いて、データをシート1に読込むようマクロを組んでいますが、どうしても、問題が解決できず困っています
>
>CSV内のデータ
>"111","222","333","444","555"
>"666","7,77","888","999","10000"
>上記のようなcsvデータがあって、
>Splitでカンマの位置で分割して配列にしているのですが、
>そうすると
>
>下記の行の場合
>"666","7,77","888","999","10000"
過去に何回かありましたが。
参考にして下さい。
Option Explicit
Sub TEST_CSV_READ()
Dim intFno As Integer
Dim strIFNm As String
Dim strOFNm As String
Dim bytBuf() As Byte
Dim vV As Variant
Dim vA As Variant
Dim vR As Variant
Dim sA As String
Dim i As Long
Dim j As Long
Dim x As Long
Dim y As Long
Dim eCol As Long
' InPut用CSVファイル
strIFNm = "D:\Excel\Test1.csv"
intFno = FreeFile
Open strIFNm For Binary As #intFno
ReDim bytBuf(LOF(intFno) - 1)
Get #intFno, , bytBuf
Close #intFno
vV = StrConv(bytBuf, vbUnicode)
vV = Split(vV, vbCrLf)
' 1行目がタイトル行で桁数をチェック
eCol = UBound(Split(vV(0), ","))
' タイトル行が無い時は予め列数を固定して置く
' eCol = 5 とかを 0 Baseで。
ReDim vR(1 To UBound(vV), 1 To eCol + 1)
For i = 1 To UBound(vV) - 1
sA = Replace(vV(i), vbCrLf, "")
If UBound(StrSplit(sA)) < eCol + 1 Then
j = i
Do While UBound(StrSplit(sA)) < eCol + 1
j = j + 1
sA = sA & Replace(vV(j), vbCrLf, "")
Loop
i = j
Else
sA = vV(i)
End If
vA = StrSplit(Replace(sA, vbCrLf, ""))
x = x + 1
For j = 1 To UBound(vA)
vR(x, j) = vA(j)
Next
Next
With Worksheets("Sheet1")
.Cells.ClearContents
.Range("A1").Resize(x, eCol + 1).Value = vR
End With
End Sub
Function StrSplit(mStr As String) As Variant
Dim strArys() As String
Dim strAry() As String
Dim strD As String
Dim varD() As Variant
Dim lngCnt As Long
Dim i As Long
strArys = Split(mStr, ",")
For i = 0 To UBound(strArys)
If strArys(i) Like "*""" Then
ReDim Preserve strAry(lngCnt)
strAry(lngCnt) = strArys(i)
lngCnt = lngCnt + 1
Else
ReDim Preserve strAry(lngCnt)
If strArys(i) Like """*" Then
strAry(lngCnt) = strArys(i)
Do While Not strArys(i) Like "*"""
i = i + 1
If UBound(strArys) < i Then Exit Do
strAry(lngCnt) = strAry(lngCnt) & "," & strArys(i)
Loop
Else
strAry(lngCnt) = strArys(i)
End If
lngCnt = lngCnt + 1
End If
strD = strAry(lngCnt - 1)
ReDim Preserve varD(1 To lngCnt)
If Left(strD, 1) = """" And Right(strD, 1) = """" Then
varD(lngCnt) = Mid(strD, 2, Len(strD) - 2)
Else
varD(lngCnt) = strD
End If
Next
StrSplit = varD
End Function
|
|