ダブルコーテーションCSVファイルを入力・出力するExcelツール

2022年10月30日

CSVファイルを編集する際、CSVファイルを一旦Excel上に取り込んでデータを加工する場合が多いかと思いますが、Excel上に取り込むとダブルコーテーションが取れてしまい、再度CSVファイルにする場合はダブルコーテーションなしのデータになってしまいます。
今回はそれを回避する方法として、Excel上でCSVファイルを編集した後もダブルコーテーション付きのデータが作成できるExcelツールを作成しましたのでご紹介します。

利用方法

1.CSVファイルの読み込み
「ダブルコーテーションCSVファイル読込み」ボタンをクリックすると、CSVファイルを選択するためのダイアログが表示されますのでExcel上に読み込むファイルを選択して、「開く」ボタンを選択します。
この読み込み機能によって、データ内にカンマが入っている場合でも、そこでデータは分割されなくなります。


2.CSVファイルの出力
「ダブルコーテーションCSVファイル出力」ボタンをクリックすると、当Excelツールが保存されているフォルダにCSVファイルが出力されます。
ファイル名は年月日-時分秒の形で「YYYYMMDD-HHMMSS.csv」として保存されます。

処理内容

処理の大まかな流れは下記の通りです。

1.CSVファイルの読み込み

 既存のデータ削除
    ↓
 読み込むCSVファイルを選択
    ↓
 CSVファイルを1行ずつ読み込む
    ↓
 読み込む際にデータ内にカンマがある場合があるのでデータの区切りを「,」→「;」に変換
    ↓
 「;」で区切りなおしたCSVデータを1件づつExcelのセルにセット
    ↓ 
 Excelのセルに入れたデータからダブルコーテーションを削除
    ↓
 読み込み完了メッセージの表示


2.CSVファイルの出力

 保存先パスを設定
    ↓
 ファイル名につける「年月日-時分秒」を取得
    ↓
 出力するファイル名を指定
    ↓
 セルに入っているデータにダブルコーテーションをつけてCSV出力
    ↓
 出力完了メッセージの表示

コード    アプリの作成手順はこちら

以下がダブルコーテーションCSVファイルを入力・出力するExcelツールのプログラムコードです。上記リンク先のアプリの作成手順に従ってエクセルのボタンを作成すると今回ご紹介したExcelツールが完成します。
コード中の「 ***** 」印の箇所は状況に応じて適切な数字に変えてください。

Option Explicit

Sub ダブルコーテーションCSVファイル読込み()

   '変数を定義する
    Dim buf  As String, tmp As Variant, i As Long, j As Long, k As Long
        
   'データ最終行列を入れる変数を定義
    Dim myLastr As Long
    Dim myLastc As Long
    
   'データ最終行を取得
    myLastr = Trim(Str(Cells(Rows.Count, 2).End(xlUp).Row))
   'データ最終列を取得
    myLastc = Trim(Str(Cells(5, Columns.Count).End(xlToLeft).Column))
    
   '既存のデータを削除
    Range(Cells(5, 2), Cells(myLastr, myLastc)).ClearContents
     
 
   '当Excelファイルがあるカレントパスを取得
    Dim xPath  As String
    With ActiveWorkbook
     xPath = .Path & "\"
    End With
 
   '当Excelファイルがあるカレントドライブを指定
    ChDir xPath

   'カレントドライブのフォルダを開く
    Dim varFileName As Variant
    varFileName = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv", _
                  Title:="CSVファイルの選択")
                  
    'キャンセルボタンを選択した場合
    If varFileName = False Then
        Exit Sub
    End If
    
    'エクセルシートの5行目からCSVデータをセットする ********************************
    i = 5
   
    'CSVファイル読み込み
    Open varFileName For Input As #1

      '「,」を「;」に変換するための各種変数を定義
       Dim strmoji As String '1文字分を入れる変数
       Dim buf1 As String    '「,」を「;」に変換した文字列を入れる変数
       Dim a As Long         '文字数を入れるカウント変数

      'CSVデータがなくなるまでループ
       Do Until EOF(1)
       
          'CSVデータの1行目を読込む
          Line Input #1, buf

         'ダブルクォーテーションで囲まれているデータを読み込む
         '(データ内にカンマが入っている場合にも対応)
        
          'csv列方向データ数カウントの初期値を「1」に設定
          j = 1
          For a = 1 To Len(buf)  'bufの文字数分だけ繰り返す
           
            strmoji = Mid(buf, a, 1) 'burから現在の1文字を切り出す
        
           '「",」のパターンがきたら「;」に変換
            If Right(buf1, 1) = """" And strmoji = "," Then
               strmoji = ";"
             
               'csv列方向データ数をカウント
               j = j + 1
              
            End If
         
            '取り出した文字を連結
            buf1 = buf1 & strmoji
        
          Next
           
          '連結した文字を区切り文字「;」で配列に変換
          tmp = Split(buf1, ";")
                                                                    
          '配列データから1データづつ取り出してExcelのセルにセット
          For k = 1 To j
           'csv列方向のデータをExcelのセルにセット
           Cells(i, k + 1) = tmp(k - 1)
          Next k
                                      
          '次のデータ行に移動
          i = i + 1
         
          '前行のデータをクリア
          buf1 = ""
       Loop
          
    'CSVファイルを閉じる
    Close #1
   
   'Excelのセルに入れたデータからダブルコーテーションを削除
   
    'データ最終行を取得
    myLastr = Trim(Str(Cells(Rows.Count, 2).End(xlUp).Row))
    'データ最終列を取得
    myLastc = Trim(Str(Cells(5, Columns.Count).End(xlToLeft).Column))
    
    '列番号をアルファベットに変換
    Dim myLastcL As String
    '列番号をアルファベットに変換する(変換関数については最後に記載)
    myLastcL = ConvertToLetter(myLastc)
    
    'データ範囲をmyRange変数にセット
    Dim myRange As Range
    '読み込んだExcelのデータ範囲をセット
    Set myRange = Range("B5:" & myLastcL & myLastr)
    
    '上記範囲のデータからダブルコーテーションを削除
    Call myRange.Replace("""", "")
    
    'A1のセルを選択して終了
     Range("A1").Select
     
End Sub


'--------------------------------------------------------------------------

Sub ダブルコーテーションCSVファイル出力()

 Const cnsTitle = "CSVファイル出力" '「名前を付けて保存」ダイアログのタイトル
 Dim xlAPP As Application  'Excel.Applicationオブジェクトの定義
 Dim varFileName As String '出力先ファイル名の変数定義
 Dim X(2 To 7) As Variant  '書き出すレコード内容のリスト変数を定義
 Dim lngRow As Long        '処理データ行の変数定義
 Dim rowLast As Long       'データ最終行の変数定義
 Dim colLast As Long       'データ最終行の変数定義
 Dim col As Long           'カラム変数の定義
 Dim xPath As String       '出力先パス変数の定義
 Dim FileNumber            '使用可能なファイル番号を入れる変数を定義
 Dim line As String        '文字列を連結したデータを入れる変数を定義
 
 'Applicationオブジェクト取得
 Set xlAPP = Application
 
 '保存先パスの設定
 With ActiveWorkbook
  xPath = .Path & "\"  'サンプルアプリがあるフォルダを指定
 End With
 
 
 '現在日時をファイル名のデフォルト値に指定
 Dim strDate As String
 strDate = Format(Now, "yyyymmdd-hhnnss")
 
 'データ(B列)最終行を取得
 rowLast = Cells(Rows.Count, 2).End(xlUp).Row
 'データ(5行目)最終列を取得
 colLast = Trim(Str(Cells(5, Columns.Count).End(xlToLeft).Column))

 'タイトル行を含め5行に満たない場合は出力しない ******************
 If rowLast < 5 Then
   xlAPP.StatusBar = False
   MsgBox "出力出来るデータがありません。", , cnsTitle
   Exit Sub
 End If

 'csv出力先とファイル名を指定
 varFileName = xPath & strDate & ".csv"
    
 '使用可能なファイル番号を取得
 FileNumber = FreeFile

 '指定ファイルをOpen(出力モード)にする
 Open varFileName For Output As #FileNumber

 '開始行を指定 *****************************************
 lngRow = 5

 '最終行まで繰り返す
 Do Until lngRow > rowLast
      
   '配列Xの再初期化
   Erase X
   
  'B~G列のExcelデータをダブルコーテーション括りの文字列として出力する
   '文字列を入れる変数を初期化
   line = ""
   
   'Excelデータがセットされている2列目からデータ最終列までループ ****************
   For col = 2 To colLast
   
  'CSVテキスト項目に出力できない文字を除去する(下記「FP_CutInjusticeChar」関数参照)
    X(col) = CutChar(Cells(lngRow, col).Value)
    
    '各データにダブルコーテーションを付けてデータを連結する
    line = line & """" & X(col) & """"
            
    '最終データ以外だったら「,」を追加
    If col <> colLast Then
       line = line & ","
    End If
     
   '次の列のデータに移動
   Next col
  
  'CSVデータ出力
   Print #1, line

   'データ処理件数をカウント
   lngRow = lngRow + 1
   xlAPP.StatusBar = "出力中です....(" & lngRow - 1 & "レコード目)"
 
 Loop
 
 '出力したCSVファイルを閉じる
 Close #FileNumber
 
 'ステータスバーの文字を非表示にする
 xlAPP.StatusBar = False
 
 '終了メッセージ
  MsgBox "CSV出力が完了しました。" & vbCr & _
  "レコード件数=" & lngRow - 6 & "件", vbInformation, cnsTitle
  
End Sub


'--------------------------------------------------------------------------

'CSVテキスト項目に出力できない文字を除去する関数
Private Function CutChar(varInText As Variant) As Variant
 Dim strInText As String  'テキストを格納する変数を定義
 Dim POS As Long          '文字列の桁数を格納する変数を定義
 Dim strChar As String    '1文字を格納する変数を定義
 Dim strOutText As String '1文字ずつ結合した文字を格納する変数を定義
    
 CutChar = Empty
 
 '一旦、文字列に変換する
 strInText = Trim$(CStr(varInText))
 
 'ブランクの場合は処理なし
 If strInText = "" Then Exit Function
    
 '文字列の桁数分を繰り返す
 strOutText = ""
 For POS = 1 To Len(strInText)
 
  '1文字を取り出す
  strChar = Mid(strInText, POS, 1)
  
  '改行コードとダブルクォーテーションを省く
  If ((strChar <> vbCr) And (strChar <> """")) Then
  
   '取り出した文字を結合する
   strOutText = strOutText & strChar
   
  End If
  
 Next POS
 
 '改行コードとダブルクォーテーションを省いた文字列を返す
 CutChar = strOutText
 
End Function


'--------------------------------------------------------------------------

'列番号をアルファベットに変換する関数
Function ConvertToLetter(iCol As Long) As String
   Dim a As Long
   Dim b As Long
   a = iCol
   ConvertToLetter = ""
   Do While iCol > 0
      a = Int((iCol - 1) / 26)
      b = (iCol - 1) Mod 26
      ConvertToLetter = Chr(b + 65) & ConvertToLetter
      iCol = a
   Loop
End Function

上記にある列番号をアルファベットに変換する関数は以下リンク先のコードを使わさせて頂きました。
https://learn.microsoft.com/ja-jp/office/troubleshoot/excel/convert-excel-column-numbers