Excel VBA質問箱 IV

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

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


31198 / 76732 ←次へ | 前へ→

【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」因り前で行えば善いと思います
1 hits

【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 お礼

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