Excel VBA質問箱 IV

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

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


72890 / 76732 ←次へ | 前へ→

【8324】Re:カンマ区切りのCSVで保存した時の改行...
回答  Hirofumi E-MAIL  - 03/10/8(水) 20:56 -

引用なし
パスワード
   何か、肝心な部分が書かれて居ないので、善く説明が解らないのですが?
よって、私が使っているCSV出力のコードを載せて置きます

以下のコードは、シートの決められた列数を最終行までCSV出力します
提示したコードは、ActiveSheetをLfを改行コードとし、先頭から15列出力します
もし、シート、列数等を変更したい場合は、以下の数値等を変更して下さい

  'ファイル出力するシートの参照
  Set wksRead = ActiveSheet
  'ファイル出力する先頭行の値
  lngReadRow = 1
  'ファイル出力する先頭列の値
  lngReadCol = 1
  'ファイル出力する最終列の値
  lngReadCalEnd = 15

'以下を標準モジュールに記述して下さい

Option Explicit

Public Sub WriteCsvSequ()

  Dim vntFileName As Variant
  Dim wksRead As Worksheet
  Dim lngReadRow As Long
  Dim lngReadCol As Long
  Dim lngReadCalEnd As Long
  
  '出力名を取得します
  If Not GetWriteFile(vntFileName, ThisWorkbook.Path) Then
    Exit Sub
  End If
  
  'ファイル出力するシートの参照
  Set wksRead = ActiveSheet
  'ファイル出力する先頭行の値
  lngReadRow = 1
  'ファイル出力する先頭列の値
  lngReadCol = 1
  'ファイル出力する最終列の値
  lngReadCalEnd = 15
  
  'ファイルに出力
  CsvWrite vntFileName, vbLf, wksRead, _
          lngReadRow, lngReadCol, lngReadCalEnd
  
  '読み込むシートの参照を破棄
  Set wksRead = Nothing
  
  Beep
  MsgBox "処理が終了しました", vbOKOnly, "終了"

End Sub

Private Sub CsvWrite(ByVal strFileName As String, _
            strRetCode As String, _
            ByVal wksRead As Worksheet, _
            lngRowTop As Long, _
            lngColTop As Long, _
            lngColEnd As Long)

  Dim dfn As Integer
  Dim i As Long
  Dim j As Long
  Dim lngRowEnd As Long
  Dim strBuf As String
  Dim vntField As Variant
  
  
  '読み込み最終行を取得
  With wksRead
    lngRowEnd = .Cells(65536, lngColTop).End(xlUp).Row
  End With
  
  '空きファイル番号を取得します
  dfn = FreeFile
  '出力ファイルをOpenします
  Open strFileName For Output As dfn
    
  With wksRead.Cells(lngRowTop, lngColTop)
    For i = 0 To lngRowEnd - lngRowTop
      '1行分のDataをシートから読みこむ
      vntField = Range(.Offset(i), _
                .Offset(i, lngColEnd - 1)).Value
      '出力1レコード作成
      strBuf = ComposeLine(vntField, ",") & strRetCode
      '1レコード書き出し
      Print #dfn, strBuf;
    Next i
  End With
  
  '出力ファイルを閉じる
  Close #dfn
  
End Sub

Private Function ComposeLine(vntField As Variant, _
          Optional strDelim As String = ",") As String

'  出力レコードの作成

  Dim i As Long
  Dim strResult As String
  Dim lngFieldEnd As Long
  
  lngFieldEnd = UBound(vntField, 2)
  For i = 1 To lngFieldEnd
    strResult = strResult & PrepareCsvField(vntField(1, i))
    If i < lngFieldEnd Then
      strResult = strResult & strDelim
    End If
  Next i
  
  ComposeLine = strResult
  
End Function

Private Function PrepareCsvField(ByVal _
              strValue As String) As String

'  フィールドのダブルクォーツ付加

  Dim i As Long
  Dim blnQuot As Boolean
  Dim lngPos As Long
  Const strQuot As String = """"
  
  If Left(strValue, 1) = "'" Then
    strValue = Mid(strValue, 2)
  End If
  
  i = 1
  lngPos = InStr(i, strValue, strQuot, vbBinaryCompare)
  Do Until lngPos = 0
    strValue = Left(strValue, lngPos) _
              & Mid(strValue, lngPos + 1)
    i = lngPos + 2
    lngPos = InStr(i, strValue, strQuot, vbBinaryCompare)
  Loop
    
  For i = 1 To 5
    lngPos = InStr(1, strValue, Choose(i, ",", strQuot, _
              vbCr, vbLf, vbTab), vbBinaryCompare)
    If lngPos <> 0 Then
      blnQuot = True
      Exit For
    End If
  Next i
  
  If blnQuot Then
    strValue = strQuot & strValue & strQuot
  End If
  
  PrepareCsvField = strValue

End Function

Private Function GetWriteFile(vntFileName As Variant, _
          Optional strFilePath As String) As Boolean

  Dim i As Long
  Dim strFilter As String
  Dim strInitialFile As String
  
  'フィルタ文字列を作成
  For i = 1 To 2
    strFilter _
      = strFilter & Choose(i, "CSV File (*.csv),*.csv,", _
                  "Text File (*.txt),*.txt")
  Next i
  
  '既定値のファイル名を設定
  strInitialFile = vntFileName
  
  '読み込むファイルの有るフォルダを指定
  If strFilePath <> "" Then
    'ファイルを開くダイアログ表示ホルダに移動
    ChDrive Left(strFilePath, 1)
    ChDir strFilePath
  End If
  
  vntFileName _
    = Application.GetSaveAsFilename(vntFileName, strFilter, 1)
  If vntFileName = False Then
    Exit Function
  End If

  GetWriteFile = True
  
End Function

0 hits

【7690】カンマ区切りのCSVで保存した時の改行を削除したいのですが。。。 でこぽんウマイ! 03/9/11(木) 21:49 質問
【7706】Re:カンマ区切りのCSVで保存した時の改行を... Jaka 03/9/12(金) 14:11 回答
【7879】Re:カンマ区切りのCSVで保存した時の改行を... でこポンうまい!! 03/9/21(日) 23:41 質問
【7889】Re:カンマ区切りのCSVで保存した時の改行を... Jaka 03/9/22(月) 13:48 回答
【7891】Re:カンマ区切りのCSVで保存した時の改行を... BOTTA 03/9/22(月) 16:38 回答
【7901】Re:カンマ区切りのCSVで保存した時の改行を... ichinose 03/9/22(月) 23:46 回答
【8311】Re:カンマ区切りのCSVで保存した時の改行... でこぽんウマイ! 03/10/8(水) 11:25 発言
【8494】Re:カンマ区切りのCSVで保存した時の改行... でこぽんウマイ! 03/10/20(月) 14:29 お礼
【7904】Re:カンマ区切りのCSVで保存した時の改行を... Hirofumi 03/9/23(火) 8:58 発言
【8242】Re:カンマ区切りのCSVで保存した時の改行... でこポンうまい!! 03/10/6(月) 1:21 質問
【8324】Re:カンマ区切りのCSVで保存した時の改行... Hirofumi 03/10/8(水) 20:56 回答
【8326】Re:カンマ区切りのCSVで保存した時の改行... Hirofumi 03/10/8(水) 21:26 発言

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