Excel VBA質問箱 IV

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

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


3909 / 13644 ツリー ←次へ | 前へ→

【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 発言[未読]

【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

【59395】Re:でっかいCSVをExcelでサクッと開きたい
発言  n  - 08/12/9(火) 18:38 -

引用なし
パスワード
   どうやら最後のレスは読んでもらえてなかったみたい?
//excelfactory.net/excelboard/exgeneral/cfs.cgi?word=90810&andor=and&logs=10.txt

【59396】Re:でっかいCSVをExcelでサクッと開きたい
発言  kanabun  - 08/12/9(火) 18:47 -

引用なし
パスワード
   ▼りった さん:

こんにちは。
>Open x For Binary As y で読む方法を検討中です。
>しかし、コーディングしてみたところ遅いです。
>(推測ですが、Nバイト目でなくN文字目と見てるので、でかくなるとやたらと時間かかるんですかね。)

その方法はいろいろあるテキストファイルの読み込み法のなかで、最速の
方法です。(APIと同等かそれ以上)

なので、問題は その
> CSVの書式
にあると思います。

とくに、
>・ダブルクォーテーション内に改行が有りうる。改行コードは複数種類有り得る様子。(CR,LF,CRLF)
フィールドデータの中に CRLFがあったら、一括読み込んだデータを
行に分割することすらできなくなります。
そのような書式で出力する必要がほんとにあるのか? そこまで戻って
吟味したほうがよろしいかと思います。

そういう特殊なコードを持たない 普通のダブルクォート付きのCSVファイルなら、
拡張子を .txt に変えてOpenTextメソッドで開くか、
同じことですが、
メニュ−[データ]−[外部データの取り込み]−
[テキストファイルのインポート]
から、テキストファイルウィザード使って 列のデータ型を指定して読み込む
ほうが、はるかに安全で高速です。
テキストファイルウィザード使えば、日付の書式も「YMD」とか指定できますし。

あと、蛇足です。

> ReDim buff(iLen)
> Open sPath For Binary As #FNo
> Get #FNo, , buff

読み込みサイズが 1バイト多いですね?
 ReDim buff(1 To iLen)
じゃないですか?

【59400】Re:でっかいCSVをExcelでサクッと開きたい
発言  Hirofumi  - 08/12/9(火) 21:43 -

引用なし
パスワード
   此の方が気分速いかな?

Option Explicit

Public Sub DataRead()

  Dim i As Long
  Dim vntFileName As Variant
  Dim lngRow As Long
  Dim strPath As String
  Dim rngResult As Range
  Dim strProm As String
  
  '指定形式のファイル名を取得
  strPath = ThisWorkbook.Path
  vntFileName = "test"
  If Not GetReadFile(vntFileName, strPath) Then
    strProm = "マクロがキャンセルされました"
    GoTo Wayout
  End If

  '◆出力先頭セル位置を設定(基準セル位置)
  Set rngResult = ActiveSheet.Cells(1, "A")
  
  '画面更新を停止
  Application.ScreenUpdating = False
    
  'データの読み込み
  CSVRead vntFileName, rngResult, lngRow

  strProm = "処理が完了しました"

Wayout:

  Set rngResult = Nothing

  '画面更新を再開
  Application.ScreenUpdating = True

  MsgBox strProm, vbInformation

End Sub

Private Sub CSVRead(ByVal strFileName As String, _
          ByRef rngWrite As Range, _
          Optional ByRef lngRow As Long = 1, _
          Optional strDelim As String = ",")

  '1回の出力行数
  Const clngOutput As Long = 30
  
  Dim i As Long
  Dim vntResult As Variant
  Dim lngCount As Long
  Dim dfn As Integer
  Dim vntField As Variant
  Dim lngColumns As Long
  Dim strBuff As String
  Dim blnMulti As Boolean
  Dim strRec As String
  
  '出力用配列確保
  ReDim vntResult(1 To clngOutput, 0)
  
  'ファイルをOpen
  dfn = FreeFile
  Open strFileName For Input As dfn

  Do Until EOF(dfn)
    '1行読み込み
    Line Input #dfn, strBuff
    '論理レコードに物理レコードを追加
    strRec = strRec & strBuff
    '論理レコードをフィールドに分割
    vntField = SplitCsv(strRec, strDelim, , , blnMulti)
    'フィールド内で改行が無い場合
    If Not blnMulti Then
      lngColumns = UBound(vntField)
      '出力行数に達した場合
      If lngCount = clngOutput Then
        'データを出力
        With rngWrite.Offset(lngRow)
          '出力範囲を文字列に設定
'          .Resize(lngCount, UBound(vntResult, 2) + 1).NumberFormat = "@"
          'データを出力
          .Resize(lngCount, UBound(vntResult, 2) + 1).Value = vntResult
        End With
        lngRow = lngRow + clngOutput
        lngCount = 0
      End If
      lngCount = lngCount + 1
      If UBound(vntResult, 2) < lngColumns Then
        ReDim Preserve vntResult(1 To clngOutput, lngColumns)
      End If
      For i = 0 To lngColumns
        vntResult(lngCount, i) = vntField(i)
      Next i
      For i = lngColumns + 1 To UBound(vntResult, 2)
        vntResult(lngCount, i) = Empty
      Next i
      strRec = ""
    Else
      'セル内改行として残す場合
'      strRec = strRec & vbLf
      strRec = strRec & " "
    End If
  Loop
  
  If lngColumns > 0 Then
    With rngWrite.Offset(lngRow)
      '出力範囲を文字列に設定
'      .Resize(lngCount, UBound(vntResult, 2) + 1).NumberFormat = "@"
      'データを出力
      .Resize(lngCount, UBound(vntResult, 2) + 1).Value = vntResult
    End With
  End If
  
  Close #dfn

End Sub

Private 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

  Dim i As Long
  Dim lngDPos As Long
  Dim vntData() As Variant
  Dim lngStart As Long
  Dim vntField As Variant
  Dim lngLength As Long

  i = 0
  lngStart = 1
  lngLength = Len(strLine)
  blnMulti = False
  Do
    ReDim Preserve vntData(i)
    If Mid$(strLine, lngStart, 1) <> strQuote Then
      lngDPos = InStr(lngStart, strLine, _
            strDelimiter, vbBinaryCompare)
      If lngDPos > 0 Then
        vntField = Mid$(strLine, lngStart, _
                  lngDPos - lngStart)
        If lngDPos = lngLength Then
          ReDim Preserve vntData(i + 1)
        End If
        lngStart = lngDPos + 1
      Else
        vntField = Mid$(strLine, lngStart)
        lngStart = lngLength + 1
      End If
    Else
      lngStart = lngStart + 1
      Do
        lngDPos = InStr(lngStart, strLine, _
                strQuote, vbBinaryCompare)
        If lngDPos > 0 Then
          vntField = vntField & 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
              vntField = vntField & strQuote
          End Select
        Else
          blnMulti = True
          vntField = Mid$(strLine, lngStart)
          lngStart = lngLength + 1
          Exit Do
        End If
      Loop
    End If
    vntData(i) = vntField
    vntField = Empty
    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 & "{TAB}", False
  End If
  '「ファイルを開く」ダイアログを表示
  vntFileNames _
      = Application.GetOpenFilename(strFilter, 1, , , blnMultiSel)
  If VarType(vntFileNames) = vbBoolean Then
    Exit Function
  End If
  
  GetReadFile = True
  
End Function

【59407】Re:でっかいCSVをExcelでサクッと開きたい
発言  Yuki  - 08/12/10(水) 8:44 -

引用なし
パスワード
   ▼りった さん:
>Accessに入れてみたり、ODBCに入れてみたりしてだましだまし運用しているのですが、どちらも微妙な制限が付きまとうので、

上記のことがどのようなことか分かりませんが、
下記の要領で試してみて下さい。

Sub Ado_CsvTest()
  Dim cn     As ADODB.Connection
  Dim rs     As ADODB.Recordset
  Dim strFName  As Variant
  Dim strDBName As String
  Dim strTBLName As String
  Dim strSQL   As String
  Dim i     As Long
  
  'strFName = ThisWorkbook.Path & "\TEST.csv"
  
  'データベース名およびテーブル名の生成
  strTBLName = "TEST.csv"
  strDBName = ThisWorkbook.Path & "\"
  
  'データベースに接続
  Set cn = New ADODB.Connection
  With cn
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .Properties("Data Source").Value = strDBName
    .Properties("Extended Properties").Value = "Text;HDR=Yes;"
  End With
  cn.Open
  
  strSQL = "SELECT * FROM [" & strTBLName & "]"
  
  'レコードセットを取得
  Set rs = New ADODB.Recordset
  With rs
    .ActiveConnection = cn
    .CursorLocation = adUseClient
    .CursorType = adOpenStatic
    .LockType = adLockReadOnly
    .Source = strSQL
    .Open , , , , adCmdText
  End With
  
  With Worksheets("Sheet1")
    .Cells.ClearContents
    For i = 1 To rs.Fields.Count
      .Cells(1, i).Value = rs.Fields(i - 1).Name
    Next
    .Range("A2").CopyFromRecordset rs
  End With
  rs.Close
  cn.Close
  Set rs = Nothing
  Set cn = Nothing
End Sub

【59415】全部に返信
発言  りった  - 08/12/10(水) 16:08 -

引用なし
パスワード
   個別に返信すると話が発散しそうなので、全部に返信します。
色々コードを頂きましたが、理解するのに時間がかかりそうなので、一旦返信します。

nさんへ
[データ]-[外部データの取り込み]-[データの取り込み]
の方法も以前TRYしました。
取り込むこと自体は出来ましたが、途中でデータが切れたりしてよく解かりませんでした。
データをアップして質問するわけにも行かず、問題が起きる条件も良く解からずで、断念していました。
「Open x For Binary As y で読む方法」なら、100%自分のコードなので、Tryしてます。

kanabunさんへ
> フィールドデータの中に CRLFがあったら、一括読み込んだデータを
> 行に分割することすらできなくなります。
そうですね。CRLFでブチっと1行に切って、1行毎処理できれば良いのですが...
ちなみに、普通のCSVの書式はセル内はLFのみ(CRですか?)で、一行終わってCRLFですか?
今回の質問とはそれますが後学の為に御教示下さい。

> そのような書式で出力する必要がほんとにあるのか? そこまで戻って
> 吟味したほうがよろしいかと思います。
お客様のCSVの仕様ですし、Excelで普通に開ける(ものによっては30分かかりますが)ので、改善依頼も出せません。
もともとCSV出力自体がおまけ機能的に追加された機能ですし、
でっかいシステムが吐き出すCSVなので、変えれそうに有りません。

> 読み込みサイズが 1バイト多いですね?
>  ReDim buff(1 To iLen)
> じゃないですか?
toを使う宣言を知りませんでした。有難う御座います。

Hirofumiさんへ
改行がスペースになってしまいました。
実運用データだとエラーになってしまっうため、速度は未明です。

Access
前にやった方法はVBAではありません。Accessを起動→リンクテーブル作成→エクスポートです。
その際は、255バイトで切れてしまうため諦めました。
(データ型を変えれば良いのでしょうが、列数が多く、列の増減がありうるので
ちなみに頂いたコードを試したところ、改行が__になってしまいました。
実運用データだとエラーになってしまっうため、速度は未明です。

【59416】┏(;〃。_ 。〃)┓すみません
発言  りった  - 08/12/10(水) 16:43 -

引用なし
パスワード
   済みません。今更ですが、、、
行の最後の改行コードがLFでした(汗)
前にCRLFを見たような気がする(気のせいかもしれませんが)ので
CSVファイルを出力するシステムのバージョン等によって違うのかも知れません。

CSVの方が変なので何があっても対応出来るよう、
Byteで読む→1バイトコードか判定 でグリグリやります。
50MByteぐらいあるので多少心配ですが。

【59418】Re:全部に返信
発言  neptune  - 08/12/10(水) 16:55 -

引用なし
パスワード
   ▼りった さん:
こんにちは

沢山の方からResが付いてますね。
1行ずつ読み込めますか?Line Inputで。

それで駄目なら先ず、CSVの仕様をはっきりさせては如何ですか?

客先に行の改行コードなど、どんな仕様でCSV出力しているのか問い合わせても良いし。
その程度なら問題ないでしょ?

バイナリエディタで見ても、判りそうですし。
改行コードを指定できるエディタで開いて、vbcrlfでキチンと1行データごと
に改行されるかどうか確認しても良いし。(サクラエディタはできるみたい)
もし、エディタで開いて1行データごとに改行されないとなると、
何らかの約束毎が無いと出来ないのでは?

こうなると、もしかしたらカンマ区切り混在の固定長ファイル???
とも思ってしまいます。

【59419】Re:┏(;〃。_ 。〃)┓すみません
発言  neptune  - 08/12/10(水) 17:01 -

引用なし
パスワード
   ▼りった さん:
すれ違ったな^ ^;;
>CSVの方が変なので何があっても対応出来るよう、
>Byteで読む→1バイトコードか判定 でグリグリやります。
>50MByteぐらいあるので多少心配ですが。
2回に分ければどうですか?やった事はないですけど。
昔の記憶ですけど、O/Sも古かった時代ですが、数10MBを超えると
遅くなったと何かで読んだ記憶があります。今はメモリも贅沢に積んでいるから
大丈夫ですかね???

取りあえず、1行ずつ読み込んでも良いのでは?
時間は数10分に比べれば大して変わりません。

【59451】Re:┏(;〃。_ 。〃)┓すみません
発言  りった  - 08/12/11(木) 17:16 -

引用なし
パスワード
   2回に分けるの方法が解からないのと、
バイトで見てぐりぐりやるのはC言語で似たものを経験済みなので、
とりあえずはバイトでやってみます。

バイトでやってみてパフォーマンスの問題があれば、2回に分ける方法を検討します。

【59544】ヘ(´_`)ヘ
お礼  りった  - 08/12/17(水) 20:12 -

引用なし
パスワード
   >2回に分けるの方法が解からないのと、
>バイトで見てぐりぐりやるのはC言語で似たものを経験済みなので、
>とりあえずはバイトでやってみます。

やっぱり遅くて使い物になりませんね。

セル内改行がLFでレコードの終端がCRLFのファイルもあったので(※)、
neptuneさんに御教示頂いた、Splitでちぎる方法も試してみました。
ちぎる処理はさくっと動くのですが m(..)m、
Excelに出力するのにやたらと時間がかかりました。
(2K位のファイルで試したところ普通に開いた方が早い。)

For i = 0 To yMax
 xMax = UBound(y(i))
 For j = 0 To xMax
  ws.Cells(i + 1, j + 1).Value = y(i)(j)
 Next
Next

※やはり元データを出力するツールの版(?)によって改行コードが違いました。
 レコードの終端がLFの版も有ります。

御教示頂きながら恐縮ですが、諦めます。

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