Excel VBA質問箱 IV

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

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


39603 / 76738 ←次へ | 前へ→

【42245】Re:セル中の文字の置き換え方法での
回答  Hirofumi  - 06/9/4(月) 22:14 -

引用なし
パスワード
   カンマが複数の場合、この方が善いかも?

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 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
    '"="を""に置き換え
    strREC = Replace(strREC, "=", "")          '☆追加
    '論理レコードをフィールドに分割
    vntField = SplitCsv(strREC, strDelim, , , blnMulti)
    'フィールド内で改行が有る場合
    If Not blnMulti Then
      '★
      For i = 0 To UBound(vntField)           '☆追加
        '各Fieldで先頭に"="が必要なら
'        vntField(i) = "=" & vntField(i)       '☆追加
        '","を"。"に変換する場合
        vntField(i) = Replace(vntField(i), ",", "。") '☆追加
      Next i                      '☆追加
      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
0 hits

【42104】セル中の文字の置き換え方法での 質問(煮詰まった) 06/9/1(金) 9:49 質問
【42105】Re:セル中の文字の置き換え方法での だるま 06/9/1(金) 11:12 回答
【42227】Re:セル中の文字の置き換え方法での 質問(煮詰まった) 06/9/4(月) 16:24 質問
【42232】Re:セル中の文字の置き換え方法での かみちゃん 06/9/4(月) 17:36 発言
【42241】Re:セル中の文字の置き換え方法での Hirofumi 06/9/4(月) 20:49 回答
【42243】Re:セル中の文字の置き換え方法での Hirofumi 06/9/4(月) 21:43 回答
【42245】Re:セル中の文字の置き換え方法での Hirofumi 06/9/4(月) 22:14 回答

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