Excel VBA質問箱 IV

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

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


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

【50762】CSV→Excel(折り返し無し)変換 りった 07/8/14(火) 18:41 質問[未読]
【50763】Re:CSV→Excel(折り返し無し)変換 かみちゃん 07/8/14(火) 19:10 発言[未読]
【50764】Re:CSV→Excel(折り返し無し)変換 Hirofumi 07/8/14(火) 19:20 発言[未読]
【50765】Re:CSV→Excel(折り返し無し)変換 りった 07/8/14(火) 19:50 お礼[未読]
【50766】Re:CSV→Excel(折り返し無し)変換 Hirofumi 07/8/14(火) 20:05 発言[未読]
【50767】Re:CSV→Excel(折り返し無し)変換 Hirofumi 07/8/14(火) 20:22 発言[未読]
【50768】Re:CSV→Excel(折り返し無し)変換 Hirofumi 07/8/14(火) 20:58 発言[未読]
【50769】Re:CSV→Excel(折り返し無し)変換 りった 07/8/14(火) 21:35 質問[未読]
【50789】Re:CSV→Excel(折り返し無し)変換 Hirofumi 07/8/15(水) 20:12 回答[未読]
【50790】Re:CSV→Excel(折り返し無し)変換 Hirofumi 07/8/15(水) 20:49 発言[未読]
【50920】Re:CSV→Excel(折り返し無し)変換 りった 07/8/22(水) 13:15 お礼[未読]

【50762】CSV→Excel(折り返し無し)変換
質問  りった  - 07/8/14(火) 18:41 -

引用なし
パスワード
   いつもお世話になっております。

提供されたCSVファイルを加工する作業を毎日やっています。
CSVを開くのに8分52秒もかかるので短縮したいです。
主に行の高さの計算(やらなくていいのに勝手にやる)に処理時間がかかっているようです。(折り返しをやめて保存して開くと早い)
今まではAccessで読み込んでエクスポートしていたのですが、1セルの内容が255文字以上の内容が切り捨てられるため、Accessでの変換は不可となりました。

CSVファイルから折り返し無しのExcelファイルへの変換を行うマクロって作れそうですか?
作れそうであれば作り方を教えて下さい。
作れなさそうであればその旨記載お願いします。

データの中の「"」,「,」及び改行が有るのでストリームを自力解析は無理っぽいです。

【50763】Re:CSV→Excel(折り返し無し)変換
発言  かみちゃん  - 07/8/14(火) 19:10 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>CSVファイルから折り返し無しのExcelファイルへの変換を行うマクロって作れそうですか?

どのようなCSVファイルかよくわかりませんが、たぶんできるのではないでしょうか?

いろいろ方法はあると思います。
■「ファイル」−「開く」でテキストファイルウィザードを使って開く方法
http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_110.html
■「データ」−「外部データの取り込み」−「データの取り込み」で取り込む方法
http://www.asahi-net.or.jp/~ef2o-inue/kihon/sub01_05_22.html
■FSO(File System Object)を使う方法
http://www.officetanaka.net/excel/vba/filesystemobject/index.htm
(URLの先頭4文字は、全角になっているので、半角にしてください。)

【50764】Re:CSV→Excel(折り返し無し)変換
発言  Hirofumi  - 07/8/14(火) 19:20 -

引用なし
パスワード
   >CSVファイルから折り返し無しのExcelファイルへの変換を行うマクロって作れそうですか?
>作れそうであれば作り方を教えて下さい。
>作れなさそうであればその旨記載お願いします。
>
>データの中の「"」,「,」及び改行が有るのでストリームを自力解析は無理っぽいです

「CSVファイルから折り返し無しのExcelファイルへの変換」と言うのが解りません?
どの様な形でしょうか?

Openステートメントを使用して読むSampleです
また、処理速度は、気にしていませんので、悪しからず

尚、「Function GetReadFile」は、Excel98〜2000用ですのでExcel2002〜2007の場合
FileDialogを使用した方が上手くいくと思います

Option Explicit

Public Sub DataRead()

  Dim vntFileName As Variant
  Dim lngRow As Long
  Dim rngResult As Range
  Dim strProm As String

  '出力先頭セル位置を設定(基準セル位置)
  Set rngResult = ActiveSheet.Cells(1, "A")

  '読み込むファイルを取得
  If Not GetReadFile(vntFileName, ThisWorkbook.Path) Then
    strProm = "マクロがキャンセルされました"
    GoTo Wayout
  End If

  '画面更新を停止
  Application.ScreenUpdating = False

  '出力行初期値(基準セル位置からの行Offset)
  lngRow = 0

  'データの読み込み
  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 = ",")

  Dim dfn As Integer
  Dim vntField As Variant
  Dim strBuff As String
  Dim blnMulti As Boolean
  Dim strREC As String

  'ファイルを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
      With rngWrite.Offset(lngRow)
        With .Resize(, UBound(vntField) + 1)
          '出力範囲を文字列に設定
'          .NumberFormat = "@"
          'データを出力
          .Value = vntField
        End With
      End With
      '出力行をインクリメント
      lngRow = lngRow + 1
      strREC = ""
    Else
      'セル内改行として残す場合
      strREC = strREC & vbLf
    End If
  Loop

  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

【50765】Re:CSV→Excel(折り返し無し)変換
お礼  りった  - 07/8/14(火) 19:50 -

引用なし
パスワード
   迅速な回答ありがとうございます。

とりあえず実行してみたところエラーになってしまいました。データを提示出来ないのでこちらで出来るところまで解析します。

>「CSVファイルから折り返し無しのExcelファイルへの変換」と言うのが解りません?
>どの様な形でしょうか?

セルの書式設定で「折り返して全体を表示する」のチェックを消したものの意味で書きました。(解りにくかったようですみません)
チェックをはずして保存して開くとすぐに開けます。
開いてからなら手動でチェックはずしてしまいなのですが初回開くときに時間がかかり、開く前にチェックはずす方法は不明です。

【50766】Re:CSV→Excel(折り返し無し)変換
発言  Hirofumi  - 07/8/14(火) 20:05 -

引用なし
パスワード
   ▼りった さん:
>迅速な回答ありがとうございます。
>
>とりあえず実行してみたところエラーになってしまいました。データを提示出来ないのでこちらで出来るところまで解析します。
>
>>「CSVファイルから折り返し無しのExcelファイルへの変換」と言うのが解りません?
>>どの様な形でしょうか?
>
>セルの書式設定で「折り返して全体を表示する」のチェックを消したものの意味で書きました。(解りにくかったようですみません)
>チェックをはずして保存して開くとすぐに開けます。
>開いてからなら手動でチェックはずしてしまいなのですが初回開くときに時間がかかり、開く前にチェックはずす方法は不明です。

何処で、ブレークしていますか?
ブレークの位置とエラー内容を教えて下さい
尚、このコードは、データとしてのダブルクォーツ、カンマ、改行コードの処理も行っています

1、データとしてのダブルクォーツは、ダブルクォーツで括られているフィールド中で、ダブルクォーツが2つ並んだ物を1つのダブルクォーツとして扱います
2、ダブルクォーツで括られているフィールド中のカンマは、データとして扱われます
3、ダブルクォーツで括られているフィールド中の改行コード(CrLf、Cr)は、
Lf(セル内改行)に置き換えられます

【50767】Re:CSV→Excel(折り返し無し)変換
発言  Hirofumi  - 07/8/14(火) 20:22 -

引用なし
パスワード
   後、この手のコードでCSVのデータを読んでいる途中でエラーが起きるのに
以下の場合が有る様です(Excelのヴァージョンに因ってエラーの出方も違う様です?)

1、1フィールドの文字列が911or914文字を超える場合のレコードを配列で出力した場合
2、フィールド先頭の「=」が有る場合、セルに代入した時点で数式として扱われる為に、数式として成り立たない場合にエラーとなる

【50768】Re:CSV→Excel(折り返し無し)変換
発言  Hirofumi  - 07/8/14(火) 20:58 -

引用なし
パスワード
   後もう1つ思い出した
もし、読み込むCSVがユニックス系の改行コードがLfの場合
Openステートメントで読み込もうとすると、全てのデータを変数に読み込んでしまう為
上手く行きません(Openステートメントでは、改行コードは、CrLf、Crだけ)
この場合、FSOを使って「Sub CSVRead」を以下の様にします


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

  Const ForReading = 1
  
  Dim vntField As Variant
  Dim strBuff As String
  Dim blnMulti As Boolean
  Dim strRec As String
  Dim objFso As Object
  Dim objFileStr As Object

  'FSOのオブジェクトを取得
  Set objFso = CreateObject("Scripting.FileSystemObject")
  '指定ファイルを読み込みモードでOpen
  Set objFileStr = objFso.OpenTextFile(strFileName, ForReading)
  
  With objFileStr
    Do Until .AtEndOfStream
      'ファイルから1行読み込み
      strBuff = .ReadLine
      '論理レコードに物理レコードを追加
      strRec = strRec & strBuff
      '論理レコードをフィールドに分割
      vntField = SplitCsv(strRec, strDelim, , , blnMulti)
      'フィールド内で改行が有る場合
      If Not blnMulti Then
        With rngWrite.Offset(lngRow)
          With .Resize(, UBound(vntField) + 1)
            '出力範囲を文字列に設定
'            .NumberFormat = "@"
            'データを出力
            .Value = vntField
          End With
        End With
        '出力行をインクリメント
        lngRow = lngRow + 1
        strRec = ""
      Else
        '改行が有った場合、単純に連結する時はElse節を削除
        'セル内改行として残す場合
        strRec = strRec & vbLf
      End If
    Loop
    .Close
  End With
  
  Set objFileStr = Nothing
  Set objFso = Nothing
  
End Sub

【50769】Re:CSV→Excel(折り返し無し)変換
質問  りった  - 07/8/14(火) 21:35 -

引用なし
パスワード
   回答ありがとうございます。

現状のエラーは下記の通りです。
アプリケーション定義またはオブジェクトのエラーです。
.Value = vntField で止まります。

1セルの文字数は1000以上のものもあり今後増える可能性もあります。
=で始まるセルも有り得ます。

【50789】Re:CSV→Excel(折り返し無し)変換
回答  Hirofumi  - 07/8/15(水) 20:12 -

引用なし
パスワード
   >現状のエラーは下記の通りです。
>アプリケーション定義またはオブジェクトのエラーです。
>.Value = vntField で止まります。
>
>1 セルの文字数は1000以上のものもあり今後増える可能性もあります。
>=で始まるセルも有り得ます。

ここで止まるのは、前回のレスの多分1、2、に該当すると思われます

「1、」に該当する部分は、フィールドの文字数が、911文字を超えた場合
セルへの代入方法を1セルづつに替えれば出来ると思います
ただし、セルの文字数の上限も有りますので(2000文字?)気を付けて下さい
「2、」の場合は、代入するセルの書式を文字列にするか、
「=」を違う文字に差し替えれば善いと思います

マイクロソフトの以下の資料を見て下さい

[XL2003] 長い文字列配列を代入すると "実行時エラー 1004" が発生する
http://support.microsoft.com/kb/818808/ja

Excel のセルに表示されるのは 1,024 文字のみ
http://support.microsoft.com/kb/211580/ja

以下のコードは、「1、」の問題に対処して見ました


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

  Dim i As Long '★追加
  Dim blnNormal As Boolean '★追加
  Dim dfn As Integer
  Dim vntField As Variant
  Dim strBuff As String
  Dim blnMulti As Boolean
  Dim strRec As String
  
  
  'ファイルを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)
    vntField = SplitCsv(strRec, strDelim, blnNormal, , , blnMulti) '★変更
    'フィールド内で改行が有る場合
    If Not blnMulti Then
      With rngWrite.Offset(lngRow)
        '出力範囲を文字列に設定(フィールド先頭の「=」対する対処)
'        .Resize(, UBound(vntField) + 1).NumberFormat = "@" '★変更
        'もし、全フィールドの文字数が911以内の場合
        If blnNormal Then '★追加
          'データを配列として出力
          .Resize(, UBound(vntField) + 1).Value = vntField '★追加
        Else '★追加
          'データを1づつセルに代入
          For i = 0 To UBound(vntField) '★追加
            .Offset(, i).Value = vntField(i) '★追加
          Next i '★追加
        End If '★追加
      End With '★追加
      '出力行をインクリメント
      lngRow = lngRow + 1
      strRec = ""
    Else
      'セル内改行として残す場合
      strRec = strRec & vbLf
    End If
  Loop

  Close #dfn

End Sub

Private Function SplitCsv(ByVal strLine As String, _
            Optional strDelimiter As String = ",", _
            Optional blnNormal As Boolean, _
            Optional strQuote As String = """", _
            Optional strRet As String = vbCrLf, _
            Optional blnMulti As Boolean) As Variant

'  ★引数に「blnNormal As Boolean」を追加

  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
  blnNormal = True '★追加
  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
    'フィールドの文字数が911を超えた場合
    If Len(vntField) > 911 Then '★追加
      blnNormal = False '★追加
    End If '★追加
    vntData(i) = vntField
    vntField = Empty
    i = i + 1
  Loop Until lngLength < lngStart

  SplitCsv = vntData()

End Function

尚、「2、」で「=」を別な文字に差し替えるなら、「Function SplitCsv」の中の
「vntData(i) = vntField」因り前で行えば善いと思います

【50790】Re:CSV→Excel(折り返し無し)変換
発言  Hirofumi  - 07/8/15(水) 20:49 -

引用なし
パスワード
   Excel2000だと、1セルに格納できる文字数は、32,767文字でその内、1,024文字が表示される様です
また、数式バーでは、32,767文字が表示される様です

Excel 2000 仕様の説明
http://support.microsoft.com/kb/264626/ja

【50920】Re:CSV→Excel(折り返し無し)変換
お礼  りった  - 07/8/22(水) 13:15 -

引用なし
パスワード
   回答ありがとう御座います。

しかしながら読込みは出来ませんでした。(とりあえず5分待ったが処理終了しない。)
テキストエディタで書いたCSVは正常に読み取れるので、業務で使っているCSVの書式が特殊なのかと思います。
回答頂いて置きながら恐縮ですが、根本的に別の方法を考えるか、開くのに8分かかる状況で我慢します。

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