CSVファイルはデータ出力を伴う様々なシステムで扱われています。
システム知識の浅いユーザーが手動でCSVファイルを触ると、大抵の場合でデータを破損させてしまいます。その主な原因は、エクセルが文字コードや改行を意図せずに変更してしまうことがあるからです。そのくせ、CSVファイルをダブルクリックするとエクセルで開いてしまうので厄介です。
Cassava Editorなど、CSVファイルを崩さずに編集できるソフトはありますが、エクセルは関数が便利なので「エクセルに読み込んでシートに表示」「シートをCSVに出力」をワンクリックで実行できるマクロを作りました。
読み込むCSVファイルの単一セル内にカンマや改行が含まれていても大丈夫なようにしています。
Option Explicit
Sub clearSheet()
'############################# 変数定義 #############################
Dim varChoice As Variant 'ユーザー選択
Dim ws As Worksheet
'############################# 既存データ削除確認 #############################
varChoice = MsgBox("Existing data on 'Data' sheet will be deleted. Please make a backup of this file if necessary. Do you wish to continue?", vbYesNo)
If varChoice = vbNo Then End 'Noを選んだらマクロ終了
'############################# Dataシート初期化 #############################
initializeSheet ("Data")
'完了メッセージ
MsgBox "Done!"
End Sub
'「Export to CSV」ボタンを押したときの処理
Sub CsvExport()
'############################# 変数定義 #############################
Dim r As Integer '行番号
Dim c As Integer '列番号
Dim intMaxRow As Integer '最大行
Dim intMaxColumn As Integer '最大列
Dim strPath As String 'CSVファイルパス
Dim strLine As String '加工済み行データ
Dim ColumnID As String '項目ID
Dim varRowsArray As Variant '列配列
Dim Stream As Object 'ストリームオブジェクト
Dim ByteData() As Byte 'バイトデータ
'############################# A1にデータが無ければ終了 #############################
If Worksheets("Data").Cells(1, 1).Value = "" Then
MsgBox "No data in Row 1 Column A."
End
End If
'############################# 保存ファイル名取得 #############################
strPath = Application.GetSaveAsFilename(InitialFileName:="EmployeeImportData.csv", FileFilter:="CSV UTF-8,*.csv")
If strPath = "False" Then End 'キャンセルが押されたらマクロ終了
'############################# Stream準備 #############################
Set Stream = CreateObject("Adodb.Stream")
With Stream
.Charset = "UTF-8" '文字エンコード
.Type = adTypeText 'テキストデータタイプ
.LineSeparator = 10 '行区切り文字をadLFに設定
.Open 'ストリームを起動
End With
'############################# 列、行取得 #############################
'列数取得
intMaxColumn = Worksheets("Data").Cells(1, Columns.Count).End(xlToLeft).Column
'行数取得 (データのない列がある可能性を考慮）
ReDim varRowsArray(intMaxColumn)
intMaxRow = 0
Dim i As Long
For i = 1 To intMaxColumn
varRowsArray(i) = Worksheets("Data").Cells(Rows.Count, i).End(xlUp).Row
If intMaxRow < varRowsArray(i) Then
intMaxRow = varRowsArray(i)
End If
Next
'############################# Stream書き込み #############################
'1行目からデータの最終行まで繰り返す
For r = 1 To intMaxRow
'strLine初期化 & 1列目読み込み
strLine = """" & Worksheets("Data").Cells(r, 1).Value & """"
'2列目から最終列までデータを読み込む
For c = 2 To intMaxColumn
strLine = strLine & "," & """" & Worksheets("Data").Cells(r, c).Value & """"
Next c
'StrLineに格納した行データを改行付きでストリームに書き込む
Stream.WriteText strLine, adWriteLine
Next r
'BOMなしにするための準備
With Stream
.Position = 0 'ストリーム内の位置
.Type = adTypeBinary 'バイナリデータタイプ
.Position = 3 'ストリーム内の位置
ByteData = .Read
End With
'ファイルの保存
With Stream
.Close
.Open
.Write ByteData 'BOMなしにする
.SaveToFile strPath, 2 'ファイル存在していても上書き
.Close
End With
'完了メッセージ
MsgBox "Done!"
End Sub
'「Read CSV」ボタンを押したときの処理
Sub CsvReadButton()
'############################# 変数定義 #############################
Dim strPath As String 'CSVファイルパス
Dim varCSV As Variant 'CSVを読み込んだ配列
Dim varChoice As Variant 'ユーザー選択
Dim ws As Worksheet
'############################# 既存データ削除確認 #############################
varChoice = MsgBox("Existing data on 'Data' sheet will be deleted. Please make a backup of this file if necessary. Do you wish to continue?", vbYesNo)
If varChoice = vbNo Then End 'Noを選んだらマクロ終了
'############################# CSVファイルパス取得 #############################
strPath = Application.GetOpenFilename(FileFilter:="CSV UTF-8,*.csv", Title:="Select CSV File")
If strPath = "False" Then End
'############################# 高速化用処理 #############################
With Application
.Cursor = xlWait 'マウスポインターを砂時計にする
.ScreenUpdating = False '処理中はエクセルシートへの変更を画面に反映しない
.Calculation = xlCalculationManual 'セルの関数が処理されるのを防ぐ
End With
'############################# Dataシート初期化 #############################
initializeSheet ("Data")
'############################# CSVファイルを配列に読み取り #############################
'配列に読み込み
varCSV = readCSVtoTemp(strPath)
'ワークシートに張り付け
Worksheets("Data").Range("A1").Resize(UBound(varCSV, 1) + 1, UBound(varCSV, 2) + 1) = varCSV
'############################# 後処理 #############################
With Application
.Cursor = xlDefault 'マウスポインターを標準に戻す
.ScreenUpdating = True 'エクセルシートへの変更を画面に反映する
.Calculation = xlCalculationAutomatic 'セルの関数が処理されるようにする
End With
'アクティブシートの変更
Worksheets("Data").Activate
MsgBox "完了しました"
End Sub
'【関数】シートの初期化
Function initializeSheet(ByVal strSheetName As String)
Dim strFlag As String '存在フラグ
Dim ws As Worksheet
'該当シートがあれば中身をクリアする
For Each ws In Worksheets
If ws.Name = strSheetName Then
ws.Activate
ws.Cells.Clear
ws.Cells.EntireColumn.ColumnWidth = ws.StandardWidth
strFlag = "Sheet exists"
End If
Next ws
'該当シートがなければ作成する
If strFlag <> "Sheet exists" Then
Set ws = Worksheets.Add(After:=ActiveSheet)
ws.Name = strSheetName
End If
End Function
'【関数】カンマと改行を区切り文字で代入
Function splitByCommaAndLine(ByVal str As String) As Variant
Dim i As Long '文字番号カウンタ
Dim strTemp As String '判定文字
Dim quotCount As Long '"カウンタ
'vbCrLfをvbLfに置き換える
If InStr(str, vbCrLf) > 0 Then
str = Replace(str, vbCrLf, vbLf)
End If
'1文字ずつ区切るべきカンマか判別する
For i = 1 To Len(str)
'strから現在の1文字を切り出す
strTemp = Mid(str, i, 1)
'代入すべき文字indexを収集する
If strTemp = """" Then
quotCount = quotCount + 1
ElseIf strTemp = "," Then
If quotCount Mod 2 = 0 Then Mid(str, i, 1) = "†"
ElseIf i = Len(str) Then
If strTemp = vbLf Or strTemp = vbCr Then GoTo EndIndent
ElseIf strTemp = vbLf Or strTemp = vbCr Then
If quotCount Mod 2 = 0 Then Mid(str, i, 1) = "‡"
End If
Next
'データを改行（‡）で区切る
splitByCommaAndLine = Split(str, "‡")
strTemp = ""
Exit Function
'最後が改行コードの場合は改行コードを除く
EndIndent:
splitByCommaAndLine = Split(Left(str, Len(str) - 1), "‡")
strTemp = ""
Exit Function
End Function
'【関数】CSVの読み込み（戻り値は配列）
Function readCSVtoTemp(ByVal FilePath As String) As Variant
'変数の定義
Dim Stream As Object 'ストリームのオブジェクト（CSVをインポート/エクスポートするライブラリ）
Dim csvAll As String 'csvの全データ
Dim csvLine As Variant 'csvの行データ（カンマで区切る前）
Dim csvLineSplit As Variant 'csvの行データ（カンマで区切った後）
Dim csvResult As Variant 'csvの補正後全データ
'CSVファイルの読み込み
Set Stream = CreateObject("Adodb.Stream")
With Stream
.Type = adTypeBinary 'バイナリで読み込む(高速化)
.Open 'ストリームを起動
.LoadFromFile FilePath 'csvのパス指定
.Position = 0 'ポジション指定
.Type = adTypeText 'テキストモードに変更
.Charset = "UTF-8" '文字エンコード
csvAll = .ReadText 'ファイルを読み込む
.Close 'ストリームの終了
End With
Set Stream = Nothing
'1行ごとにデータを区切る
csvLine = splitByCommaAndLine(csvAll)
csvAll = ""
'2次元配列の行＆列数設定
Dim RowMaxIndex As Long
RowMaxIndex = UBound(csvLine)
Dim ColumnMaxIndex As Long
ColumnMaxIndex = UBound(Split(csvLine(0), "†"))
ReDim csvResult(RowMaxIndex, ColumnMaxIndex)
'1行目から最終行まで繰り返し
Dim i As Long
Dim j As Long
For i = LBound(csvLine) To UBound(csvLine)
'カンマでデータを区切る
csvLineSplit = Split(csvLine(i), "†")
'ダブルクォーテーションなしで結果配列にコピーする
For j = LBound(csvLineSplit) To UBound(csvLineSplit)
csvResult(i, j) = Replace(csvLineSplit(j), """", "")
Next
Next
Erase csvLine
Erase csvLineSplit
'ワークシートに張り付け
'Worksheets("temp").Range("A1").Resize(RowMaxIndex + 1, ColumnMaxIndex + 1) = csvResult
readCSVtoTemp = csvResult
Erase csvResult
End Function