| |
どれほど遅いか、試して見ますか？
一度、Excelに読み込んで再度Saveしなおしているのが、1/2、3/8
の処理の為なら、このまま読み込んだだけで言い様な気がしますが？
尚、ダブルクォーツ、カンマの処理はCSVの出力ルールに準拠した積もりです
また、このコードは、アクティブシートのA1から書き出す様にして有りますので
その辺は、変更して下さい
Public Sub CSVRead()
Dim i As Long
Dim strData() As String
Dim dfn As Integer
Dim strFileName As String
Dim strBuff As String
'CSVファイル名を設定する
strFileName = ActiveWorkbook.Path + "\" + "BodyPrice.csv"
dfn = FreeFile
Open strFileName For Input As dfn
i = 1
Do Until EOF(dfn)
Line Input #dfn, strBuff
SplitLine strBuff, strData()
With Cells(i, 1)
Range(.Offset(, 0), .Offset(, UBound(strData))).Value _
= strData
End With
i = i + 1
Loop
Close #dfn
End Sub
Public Sub SplitLine(ByVal strLine As String, strData() As String, _
Optional strDelimiter As String = ",", _
Optional strQuote As String = """", _
Optional strRet As String = vbCrLf, _
Optional blnMultiLine As Boolean = False)
' strLine :分割元と成る文字列
' strDelimiter :区切り文字
Dim lngDPos As Long
Dim lngStart As Long
Dim i As Long
Dim strField As String
Dim lngLength As Long
i = 0
lngStart = 1
lngLength = Len(strLine)
blnMultiLine = False
Do
ReDim Preserve strData(i)
If Mid(strLine, lngStart, 1) <> strQuote Then
lngDPos = InStr(lngStart, strLine, strDelimiter, _
vbBinaryCompare)
If lngDPos > 0 Then
strField = Mid(strLine, lngStart, lngDPos - lngStart)
lngStart = lngDPos + 1
Else
strField = Mid(strLine, lngStart)
lngStart = lngLength + 1
End If
Else
lngStart = lngStart + 1
Do
lngDPos = InStr(lngStart, strLine, strQuote, _
vbBinaryCompare)
If lngDPos > 0 Then
strField = strField & Mid(strLine, lngStart, _
lngDPos - lngStart)
lngStart = lngDPos + 1
Select Case Mid(strLine, lngStart, 1)
Case ""
Exit Do
Case strDelimiter
lngStart = lngStart + 1
Exit Do
Case strQuote
lngStart = lngStart + 1
strField = strField & strQuote
End Select
Else
blnMultiLine = True
strField = Mid(strLine, lngStart) & strRet
lngStart = lngLength + 1
Exit Do
End If
Loop
End If
strData(i) = Trim(strField)
strField = ""
i = i + 1
Loop Until lngLength <= lngStart
End Sub
|
|
- 03/5/28(水) 23:49 -
