Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


22718 / 76732 ←次へ | 前へ→

【59391】でっかいCSVをExcelでサクッと開きたい
質問  りった  - 08/12/9(火) 17:08 -

引用なし
パスワード
   でっかいCSVを良く使用するのですが、素直に(ダブルクリック)Excelで開くとやたらと時間がかかります。ものによっては30分以上。
(セルの書式設定→折り返して全体を表示する がデフォルトでONなので、折り返し計算をしているようです。)
Accessに入れてみたり、ODBCに入れてみたりしてだましだまし運用しているのですが、どちらも微妙な制限が付きまとうので、
Open x For Binary As y で読む方法を検討中です。
しかし、コーディングしてみたところ遅いです。
(推測ですが、Nバイト目でなくN文字目と見てるので、でかくなるとやたらと時間かかるんですかね。)
速くする方法があれば御教示下さい。(読みにくくしてまで細かいところを削るつもりはありません。)

尚、CSVの書式は下記のようです。
・カンマでデータを区切っている。
・ダブルクォーテーション内に改行が有りうる。改行コードは複数種類有り得る様子。(CR,LF,CRLF)
・ダブルクォーテーションの中は任意の文字が入る。
・ダブルクォーテーション内のダブルクォーテーションはダブルクォーテーション2つ
・ダブルクォーテーション内のカンマは唯のカンマ
・日付のデータがある。(現状↓のコードを実行すると一部変な結果になる。dd/mm/yy等と認識されてるっぽい)

-------------------------------------
Option Explicit

Sub CSVtoExcel()
 Const CDEFAULTFILE = "test.csv"
 Dim buff() As Byte
 Dim FNo As Long
 Dim iLen As Long
 Dim sUTF As String
 Dim i As Long
 Dim sPath As String
 Dim rCur As Range
 Dim s As String
 Dim sCell As String
 Dim wsOut As Worksheet
 Dim iFrom As Long
 Dim iLimit As Long
 
 ' お約束
 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual
 
 ' ファイル名決定
 sPath = ThisWorkbook.Path & "\" & CDEFAULTFILE
 If MsgBox(sPath & "を変換しますか?", vbYesNo, "ファイル選択") = vbNo Then
  ChDrive Left(ThisWorkbook.Path, 2)
  ChDir ThisWorkbook.Path
  sPath = Application.GetOpenFilename("CSV ファイル (*.csv), *.csv")
  If sPath = "False" Then
   MsgBox ("キャンセルしました")
   Exit Sub
  End If
 End If
 
 ' 初期化
 Set wsOut = Sheet1
 sCell = ""
 Set rCur = wsOut.Cells(1, 1)
 wsOut.Cells.Clear
 wsOut.Cells.WrapText = False
 wsOut.Cells.RowHeight = 13 ' 意地でも折り返ししない
 iLen = FileLen(sPath)
 ReDim buff(iLen)

 ' ファイルを読み込む
 FNo = FreeFile()
 Open sPath For Binary As #FNo
 Get #FNo, , buff
 Close #FNo
 sUTF = StrConv(buff, vbUnicode)

 iLen = Len(sUTF)
 For i = 1 To iLen
  s = Mid(sUTF, i, 1)
  Select Case s
  Case """"
   iFrom = i + 1
   iLimit = iFrom
   Do
    iLimit = InStr(iLimit, sUTF, """")
    If Mid(sUTF, iLimit + 1, 1) = """" Then
     sCell = sCell & Mid(sUTF, iFrom, iLimit - iFrom + 1)
     iFrom = iLimit + 2
     iLimit = iFrom
    Else
     sCell = sCell & Mid(sUTF, iFrom, iLimit - iFrom)
     i = iLimit
     Exit Do
    End If
   Loop
  Case vbCr, vbCrLf, vbLf
   writeCell rCur, sCell
   Set rCur = rCur.Worksheet.Cells(rCur.Row + 1, 1)
   ' CRLFは改行一個 (cr とか lfの扱い自信無い。)
   If s = vbCr And Mid(sUTF, i + 1, 1) = vbLf Then
    i = i + 1
   End If
  Case ","
   writeCell rCur, sCell
   Set rCur = rCur.Offset(0, 1)
  Case Else
   sCell = sCell & s
  End Select
 Next
 writeCell rCur, sCell
 
 wsOut.Cells.WrapText = False
 wsOut.Cells.RowHeight = 13.5
 
 Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True
 MsgBox "完了"
End Sub

Function writeCell(ByRef r As Range, ByRef s As String)
 If Left(s, 1) = "-" Or Left(s, 1) = "−" Then
  s = "'" & s
 End If
 r.Value = s
 s = ""
End Function

1 hits

【59391】でっかいCSVをExcelでサクッと開きたい りった 08/12/9(火) 17:08 質問
【59395】Re:でっかいCSVをExcelでサクッと開きたい n 08/12/9(火) 18:38 発言
【59396】Re:でっかいCSVをExcelでサクッと開きたい kanabun 08/12/9(火) 18:47 発言
【59400】Re:でっかいCSVをExcelでサクッと開きたい Hirofumi 08/12/9(火) 21:43 発言
【59407】Re:でっかいCSVをExcelでサクッと開きたい Yuki 08/12/10(水) 8:44 発言
【59415】全部に返信 りった 08/12/10(水) 16:08 発言
【59416】┏(;〃。_ 。〃)┓すみません りった 08/12/10(水) 16:43 発言
【59419】Re:┏(;〃。_ 。〃)┓すみません neptune 08/12/10(水) 17:01 発言
【59451】Re:┏(;〃。_ 。〃)┓すみません りった 08/12/11(木) 17:16 発言
【59544】ヘ(´_`)ヘ りった 08/12/17(水) 20:12 お礼
【59418】Re:全部に返信 neptune 08/12/10(水) 16:55 発言

22718 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free