ダブルコーテーションCSVファイルを入力・出力するExcelツール
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
ディスカッション
コメント一覧
まだ、コメントがありません