[[20130529180314]]　『ｃｓｖデータ取込の処理UPについて』（Bo）　ページの最後に飛ぶ

『ｃｓｖデータ取込の処理UPについて』（Bo）
Windows 7　excel2010

連投すいません。もうひとつだけアドバイスをお願いします。

15万件ほどある。CSVのデータカンマ区切りで、""で囲まれているデータです。
何とかsheetに取り込むVBAを作成したのですが（ほとんどネットに書いてあることの
コピペ）非常に時間がかかるので、高速化のご助言をいただけたらと思います。

    Sub CSV入力()

'スクリーン表示の更新を抑止

        Application.ScreenUpdating = False

     Worksheets("Sheet3").Activate

        Dim varFileName As Variant
        Dim objFSO As New FileSystemObject
        Dim inTS As TextStream
        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
        Dim blnCrLf As Boolean

        varFileName = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv",Title:="CSVファイルの選択")
        If varFileName = False Then
            Exit Sub
        End If

        Set inTS = objFSO.OpenTextFile(CStr(varFileName), ForReading)
        strRec = CStr(inTS.ReadAll)

        i = 1 'シートの1行目から出力
        j = 0 '列位置はPutCellでカウントアップ
        lngQuate = 0 'ダブルクォーテーションの数
        strCell = ""
        For k = 1 To Len(strRec)
            Select Case Mid(strRec, k, 1)
                Case vbLf, vbCr '「"」が偶数なら改行、奇数ならただの文字
                    If lngQuate Mod 2 = 0 Then
                        blnCrLf = False
                        If k > 1 Then 
'改行としてのCrLfはCrで改行判定済なので無視する
                            If Mid(strRec, k - 1, 2) = vbCrLf Then
                                blnCrLf = True
                            End If
                        End If
                        If blnCrLf = False Then
                            Call PutCell(i, j, strCell, lngQuate)
                            i = i + 1
                            j = 0
                            lngQuate = 0
                            strCell = ""
                        End If
                    Else
                        strCell = strCell & Mid(strRec, k, 1)
                    End If
                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
        '最終列の処理
        If j > 0 And strCell <> "" Then
            Call PutCell(i, j, strCell, lngQuate)
        End If

        Set inTS = Nothing
        Set objFSO = Nothing

        'スクリーン表示の更新の抑止を解除
        Application.ScreenUpdating = True

    End Sub

 そのコードは 最初の1文字から最後の1文字まで、1文字づつ解析していくコードですか？
 vbCrLf でまずは行に分割してから、１行づつ処理していく手もあると思うけど？

 一番問題なのは

 > strCell = strCell & Mid(strRec, k, 1)

 といった感じで、「&演算子で文字列を連結」していることです。
 この文字列連結処理は & を一回使うたびに これまで連結した文字列と追加する
 文字列のために 別のメモリ領域を確保しなければならないので、

 > 15万件

 もあると、極端に遅くなります。

 自前で処理するのでなく、
 [外部データの取り込み]-[テキストファイルのインポート] 
 メニューでImportできないですか？

 (kanabun)

返信ありがとうございます。(BO)
csvの取込はexcelに詳しくない方が行うので、ボタン一つでできるように、VBAで作成したいのです。

 >[外部データの取り込み]-[テキストファイルのインポート] 
 が使えれば、この機能に相当するVBAコードを使えばよいのです。
 ボタン一つでできます。
 (cai)

コメント返信：

[ 一覧(最新更新順) ]

[[20130529180314]] 『ｃｓｖデータ取込の処理UPについて』（Bo） ページの最後に飛ぶ

[[20130529180314]]　『ｃｓｖデータ取込の処理UPについて』（Bo）　ページの最後に飛ぶ