Excel VBA質問箱 IV

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

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


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

【14237】CSVエクスポートについて バカボン 04/5/24(月) 11:28 質問[未読]
【14238】Re:CSVエクスポートについて Asaki 04/5/24(月) 11:37 発言[未読]
【14261】Re:CSVエクスポートについて Hirofumi 04/5/24(月) 20:53 回答[未読]
【14470】Re:CSVエクスポートについて バカボン 04/5/30(日) 15:36 お礼[未読]

【14237】CSVエクスポートについて
質問  バカボン E-MAIL  - 04/5/24(月) 11:28 -

引用なし
パスワード
   通常、エクセルにてCSVファイルを保存する時
バイト数によって、""で囲まれる文字列があります。
これを""なしで すべて,カンマ区切りにしたいのですが
どうすれば全て,カンマ区切りでcsvファイルを保存する事ができるのでしょうか?

【14238】Re:CSVエクスポートについて
発言  Asaki  - 04/5/24(月) 11:37 -

引用なし
パスワード
   こんにちは。

>バイト数によって、""で囲まれる文字列があります。
バイト数によって?ですか?
通常、データにカンマが含まれる場合に、そうなると思うのですが。

【14261】Re:CSVエクスポートについて
回答  Hirofumi E-MAIL  - 04/5/24(月) 20:53 -

引用なし
パスワード
   ダブルクォーツ無しで出力する事は、こんなコードで出来るけど
データの中に、ダブルクォーツや、改行、カンマが有ると、
読み込む時に、元の様に成らないよ?

出力したいシートでマクロを起動すると
UsedRangeが選択され、UsedRangeの範囲を表示したInputBoxが表示されます
ここで、出力範囲を変更するなら、範囲を選択し直して下さい
Okを出すと、保存のダイアログが出ますので、出力名を決めてOkを出すと
Csv出力されます

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

Option Explicit

Public Sub OutPutCsvScope()

  Dim vntFileName As Variant
  Dim rngTarget As Range
  Dim strPrompt As String
  Dim strTitle As String
  
  strPrompt = "Csv出力するRangeを選択して下さい"
  strTitle = "Csv出力"
  
  On Error GoTo ErrorHandler
  '選択範囲の取得
  With Application
    'もし、選択範囲が無いなら
    If .Selection.Count = 1 Then
      Set rngTarget = ActiveSheet.UsedRange
    Else
      Set rngTarget = .Selection
    End If
    '選択範囲の取得
    Set rngTarget = .InputBox(Prompt:=strPrompt, _
                  Title:=strTitle, _
                  Default:=rngTarget.Address, _
                  Type:=8)
    rngTarget.Select
  End With
  
  'Default出力名の設定
  vntFileName = ThisWorkbook.Path & "\" & "TestFile.csv"
  '出力名を取得
  If Not GetWriteFile(vntFileName, ThisWorkbook.Path) Then
    GoTo ErrorHandler
  End If
  
  'ファイルに出力
  CsvWrite vntFileName, rngTarget
  
  Beep
  MsgBox "処理が終了しました", vbOKOnly, "終了"
  
ErrorHandler:

  '選択範囲の解除
  rngTarget(1).Select
  Set rngTarget = Nothing
  
End Sub

Private Sub CsvWrite(ByVal strFileName As String, _
           ByVal rngTarget As Range, _
          Optional strRetCode As String = vbCrLf)

  Dim dfn As Integer
  Dim i As Long
  Dim j As Long
  Dim strBuf As String
  Dim lngCount As Long
  Dim vntField As Variant
    
  '空きファイル番号を取得します
  dfn = FreeFile
  '出力ファイルをOpenします
  Open strFileName For Output As dfn
    
  With rngTarget
    lngCount = .Columns.Count
    For i = 1 To .Rows.Count
      '1行分のDataをシートから読みこむ
      vntField = .Item(i, 1).Resize(, lngCount)
      '出力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
  Dim vntFieldTmp As Variant
  
  'もし、データが複数なら
  If VarType(vntField) = vbArray + vbVariant Then
    vntFieldTmp = vntField
  Else
    ReDim vntFieldTmp(1 To 1, 1 To 1)
    vntFieldTmp(1, 1) = vntField
  End If
  'データ数の取得
  lngFieldEnd = UBound(vntFieldTmp, 2)
  'データ数繰り返し
  For i = 1 To lngFieldEnd
    '結果変数にフィール文字列を加算
    strResult = strResult & CStr(vntFieldTmp(1, i))
    'データカウントがデータ数未満の場合
    If i < lngFieldEnd Then
      '区切り文字を結果変数に加算
      strResult = strResult & strDelim
    End If
  Next i
  
  ComposeLine = strResult
  
End Function

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

  Dim strFilter As String
  Dim strInitialFile As String
  
  'フィルタ文字列を作成
  strFilter = "CSV File (*.csv),*.csv," _
        & "Text File (*.txt),*.txt"
  '既定値のファイル名を設定
  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

【14470】Re:CSVエクスポートについて
お礼  バカボン E-MAIL  - 04/5/30(日) 15:36 -

引用なし
パスワード
   ▼Hirofumi さん:
>ダブルクォーツ無しで出力する事は、こんなコードで出来るけど
>データの中に、ダブルクォーツや、改行、カンマが有ると、
>読み込む時に、元の様に成らないよ?
>
>出力したいシートでマクロを起動すると
>UsedRangeが選択され、UsedRangeの範囲を表示したInputBoxが表示されます
>ここで、出力範囲を変更するなら、範囲を選択し直して下さい
>Okを出すと、保存のダイアログが出ますので、出力名を決めてOkを出すと
>Csv出力されます
>
>以下を標準モジュールに記述して下さい
>
>Option Explicit
>
>Public Sub OutPutCsvScope()
>
>  Dim vntFileName As Variant
>  Dim rngTarget As Range
>  Dim strPrompt As String
>  Dim strTitle As String
>  
>  strPrompt = "Csv出力するRangeを選択して下さい"
>  strTitle = "Csv出力"
>  
>  On Error GoTo ErrorHandler
>  '選択範囲の取得
>  With Application
>    'もし、選択範囲が無いなら
>    If .Selection.Count = 1 Then
>      Set rngTarget = ActiveSheet.UsedRange
>    Else
>      Set rngTarget = .Selection
>    End If
>    '選択範囲の取得
>    Set rngTarget = .InputBox(Prompt:=strPrompt, _
>                  Title:=strTitle, _
>                  Default:=rngTarget.Address, _
>                  Type:=8)
>    rngTarget.Select
>  End With
>  
>  'Default出力名の設定
>  vntFileName = ThisWorkbook.Path & "\" & "TestFile.csv"
>  '出力名を取得
>  If Not GetWriteFile(vntFileName, ThisWorkbook.Path) Then
>    GoTo ErrorHandler
>  End If
>  
>  'ファイルに出力
>  CsvWrite vntFileName, rngTarget
>  
>  Beep
>  MsgBox "処理が終了しました", vbOKOnly, "終了"
>  
>ErrorHandler:
>
>  '選択範囲の解除
>  rngTarget(1).Select
>  Set rngTarget = Nothing
>  
>End Sub
>
>Private Sub CsvWrite(ByVal strFileName As String, _
>           ByVal rngTarget As Range, _
>          Optional strRetCode As String = vbCrLf)
>
>  Dim dfn As Integer
>  Dim i As Long
>  Dim j As Long
>  Dim strBuf As String
>  Dim lngCount As Long
>  Dim vntField As Variant
>    
>  '空きファイル番号を取得します
>  dfn = FreeFile
>  '出力ファイルをOpenします
>  Open strFileName For Output As dfn
>    
>  With rngTarget
>    lngCount = .Columns.Count
>    For i = 1 To .Rows.Count
>      '1行分のDataをシートから読みこむ
>      vntField = .Item(i, 1).Resize(, lngCount)
>      '出力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
>  Dim vntFieldTmp As Variant
>  
>  'もし、データが複数なら
>  If VarType(vntField) = vbArray + vbVariant Then
>    vntFieldTmp = vntField
>  Else
>    ReDim vntFieldTmp(1 To 1, 1 To 1)
>    vntFieldTmp(1, 1) = vntField
>  End If
>  'データ数の取得
>  lngFieldEnd = UBound(vntFieldTmp, 2)
>  'データ数繰り返し
>  For i = 1 To lngFieldEnd
>    '結果変数にフィール文字列を加算
>    strResult = strResult & CStr(vntFieldTmp(1, i))
>    'データカウントがデータ数未満の場合
>    If i < lngFieldEnd Then
>      '区切り文字を結果変数に加算
>      strResult = strResult & strDelim
>    End If
>  Next i
>  
>  ComposeLine = strResult
>  
>End Function
>
>Private Function GetWriteFile(vntFileName As Variant, _
>            Optional strFilePath As String) As Boolean
>
>  Dim strFilter As String
>  Dim strInitialFile As String
>  
>  'フィルタ文字列を作成
>  strFilter = "CSV File (*.csv),*.csv," _
>        & "Text File (*.txt),*.txt"
>  '既定値のファイル名を設定
>  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


ご回答ありがとうございます。さっそく試してみたいと思います。

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