Excel VBAでCSVファイルの取込方法(16桁以上、カンマ入りの値、UTF-8文字化け対応)

VBAを使用して外部データを取り込んでデータベース化したり、特定のデータだけを整理して見やすくするというのは、基本的なテクニックであり需要も多いです。

かく言う僕も別のデータベースから抽出したデータをExcelで見やすく一覧にするというところからVBAを学びました。

外部データはCSV形式が多いのですが、CSVの中身をExcelブックに移す時はいくつか注意点があります。

その注意点を5段階に分けてコードを書いてみました。

サンプル

https://iehohs.com/ftp/excel-csv-import/csv-import.xlsm

https://iehohs.com/ftp/excel-csv-import/sample.csv

こちらがデータです。マクロ入りのExcelブックとCSVファイルです。

サンプルです。デジカメの簡単なデータベースを用意しました。ここにCSVファイルをインポートしてデータを追加します。

CSVファイルをテキストで開いたところです。CSVは「Comma Separated Value」の略で、「, (カンマ)」で区切ってExcelでいうセルを分けています。

エクスポート元にもよるのですが、各データを「”(ダブルクォーテーション)」で囲っている場合も多いです。

このCSVファイルをExcelで開くとこんな感じ。カンマごとに列が分かれており、改行ごとに行が分かれています。

ちなみにExcelで開いて上書き保存をするとダブルクォーテーションが取り除かれる仕様です。この辺りのことは詳しく知りません。

CSVをブックとして開く

CSVファイルをExcelブックとして開いて、データのやり取りをします。

サンプルの《ブック》というボタンに記録されているマクロです。

Sub csvOpenBook()
    Dim openFileName As String
    Dim rowEnd As Long
    Dim rowEnd2 As Long
    Dim setRow As Long
    Dim addFlg As Boolean
    Dim setCnt As Long
    Dim modifyCnt As Long
    Dim i As Long
    Dim j As Long
    
    If Cells(4, 1).Value <> "" Then
        Cells(3, 1).Select
        rowEnd = Selection.End(xlDown).Row
    Else
        Select Case Cells(3, 1).Value
            Case ""
                rowEnd = 2
            Case Else
                rowEnd = 3
        End Select
    End If
    
    If Dir(ThisWorkbook.Path & "\sample.csv") <> "" Then
        Workbooks.Open ThisWorkbook.Path & "\sample.csv"
    Else
        openFileName = Application.GetOpenFilename("CSV(カンマ区切り),*.csv")
        If openFileName <> "False" Then
            Workbooks.Open openFileName
        Else
            Exit Sub
        End If
    End If
    
    If Cells(3, 1).Value <> "" Then
        Cells(2, 1).Select
        rowEnd2 = Selection.End(xlDown).Row
    Else
        Select Case Cells(2, 1).Value
            Case ""
                rowEnd2 = 1
            Case Else
                rowEnd2 = 2
        End Select
    End If
    
    setCnt = 0
    modifyCnt = 0
    With ThisWorkbook.ActiveSheet
        For i = 2 To rowEnd2
            addFlg = True
            For j = 3 To rowEnd
                If "'" & Cells(i, 1).Value = "'" & .Cells(j, 1).Value Then
                    setRow = j
                    addFlg = False
                    Exit For
                End If
            Next j
            
            If addFlg = True Then
                rowEnd = rowEnd + 1
                setRow = rowEnd
                addCnt = addCnt + 1
            Else
                modifyCnt = modifyCnt + 1
            End If
            
            For j = 1 To 4
                .Cells(setRow, j).Value = Cells(i, j).Value
            Next j
        Next i
    End With
    
    ActiveWorkbook.Close SaveChanges:=False
    
    MsgBox addCnt & "件追加、" & modifyCnt & "件更新"
End Sub

CSVファイルを開き、順番にデータをチェックして同じJANコードが既に入力されている場合はデータを上書き、そうでない場合は最終行の下に追加します。

同じフォルダ内にsample.csvがあれば自動的に開き、無ければポップアップウィンドウで選択して開くようにしています。

もしMacで使用される方は、ファイルを開くコードの箇所を少し変える必要があります。

    If Dir(ThisWorkbook.Path & "/sample.csv") <> "" Then
        Workbooks.Open ThisWorkbook.Path & "/sample.csv"
    Else
        openFileName = Application.GetOpenFilename()
        If openFileName <> "False" Then
            Workbooks.Open openFileName
        Else
            Exit Sub
        End If
    End If

Macではファイルパスの区切りが「\(バックスラッシュあるいは円マーク)」ではなく「/(スラッシュ)」に変えるのと、GetOpenFilenameの引数を空白にすると動くはずです。

これでCSVファイルの中身を参照することができるのですが、取り扱うデータによっては以下のような不具合が出てしまいます。

Excelの面倒くさい仕様として、12桁以上の数値は「4.54874E+12」のように表記が変わります。

実際のデータが変換されたわけではなく、数式バーには「4548736086449」と出ています。

これを元のデータと同じように表記するには数値ではなく文字列として表示する必要があります。

この問題は簡単で、数値の頭に「’(シングルクォーテーション)」をつけると文字列扱いになります。

サンプルの《12桁対応》には以下のコードのマクロが記録されています。

Sub csvOpenBook12()
    Dim openFileName As String
    Dim rowEnd As Long
    Dim rowEnd2 As Long
    Dim setRow As Long
    Dim addFlg As Boolean
    Dim setCnt As Long
    Dim modifyCnt As Long
    Dim i As Long
    Dim j As Long
    
    If Cells(4, 1).Value <> "" Then
        Cells(3, 1).Select
        rowEnd = Selection.End(xlDown).Row
    Else
        Select Case Cells(3, 1).Value
            Case ""
                rowEnd = 2
            Case Else
                rowEnd = 3
        End Select
    End If
    
    If Dir(ThisWorkbook.Path & "\sample.csv") <> "" Then
        Workbooks.Open ThisWorkbook.Path & "\sample.csv"
    Else
        openFileName = Application.GetOpenFilename("CSV(カンマ区切り),*.csv")
        If openFileName <> "False" Then
            Workbooks.Open openFileName
        Else
            Exit Sub
        End If
    End If
    
    If Cells(3, 1).Value <> "" Then
        Cells(2, 1).Select
        rowEnd2 = Selection.End(xlDown).Row
    Else
        Select Case Cells(2, 1).Value
            Case ""
                rowEnd2 = 1
            Case Else
                rowEnd2 = 2
        End Select
    End If
    
    setCnt = 0
    modifyCnt = 0
    With ThisWorkbook.ActiveSheet
        For i = 2 To rowEnd2
            addFlg = True
            For j = 3 To rowEnd
                If "'" & Cells(i, 1).Value = "'" & .Cells(j, 1).Value Then
                    setRow = j
                    addFlg = False
                    Exit For
                End If
            Next j
            
            If addFlg = True Then
                rowEnd = rowEnd + 1
                setRow = rowEnd
                addCnt = addCnt + 1
            Else
                modifyCnt = modifyCnt + 1
            End If
            
            For j = 1 To 4
                Select Case j
                    Case 1
                        .Cells(setRow, j).Value = "'" & Cells(i, j).Value
                    Case Else
                        .Cells(setRow, j).Value = Cells(i, j).Value
                End Select
            Next j
        Next i
    End With
    
    ActiveWorkbook.Close SaveChanges:=False
    
    MsgBox addCnt & "件追加、" & modifyCnt & "件更新"
End Sub

1列目だけは頭にシングルクォーテーションを付けるという処理が加わっただけです。簡単ですね。

Excelの設定を変えることでも回避可能ですが、環境を問わないようにするにはこれが最適でしょう。

Line InputでCSVファイルを読み込む

問題は数値が16桁以上ある場合。Excelで扱える桁数は15桁までなので、元のデータが変換されてしまいます。

Excelブックとして開いた時点で値が変換されてしまっているので、あとからシングルクォーテーションを付けたとしても元のデータは失われてしまいます。

そこでCSVファイルをExcelブックではなくLine Inputステートメントを使ってデータを読み込み、配列に格納してから入力します。

サンプルの《LineInput》ボタンに記録されているマクロです。

Sub csvLineInput()
    Dim openFileName As String
    Dim rowEnd As Long
    Dim addFlg As Boolean
    Dim setCnt As Long
    Dim modifyCnt As Long
    Dim strBuf As String
    Dim strArr() As String
    Dim i As Long
    
    If Cells(4, 1).Value <> "" Then
        Cells(3, 1).Select
        rowEnd = Selection.End(xlDown).Row
    Else
        Select Case Cells(3, 1).Value
            Case ""
                rowEnd = 2
            Case Else
                rowEnd = 3
        End Select
    End If
    
    If Dir(ThisWorkbook.Path & "\sample.csv") <> "" Then
        openFileName = ThisWorkbook.Path & "\sample.csv"
    Else
        openFileName = Application.GetOpenFilename("CSV(カンマ区切り),*.csv")
        If openFileName = "False" Then
            Exit Sub
        End If
    End If

    Open openFileName For Input As #1
    
    addCnt = 0
    modifyCnt = 0
    
    Do Until EOF(1)
        Line Input #1, strBuf
        If strBuf <> "" Then
            strArr = Split(strBuf, ",")
            
            addFlg = True
            If Replace(strArr(0), """", "") <> "JANコード" Then
                For i = 3 To rowEnd
                    If "'" & Replace(strArr(0), """", "") = "'" & Cells(i, 1).Value Then
                        setRow = i
                        addFlg = False
                        Exit For
                    End If
                Next
 i
                
                If addFlg = True Then
                    rowEnd = rowEnd + 1
                    setRow = rowEnd
                    addCnt = addCnt + 1
                Else
                    modifyCnt = modifyCnt + 1
                End If
                
                For i = 0 To UBound(strArr)
                    Select Case i
                        Case 0
                            Cells(setRow, i + 1).Value = "'" & Replace(strArr(i), """", "")
                        Case Else
                            Cells(setRow, i + 1).Value = Replace(strArr(i), """", "")
                    End Select
                Next i
            End If
        End If
    Loop
    
    Close #1
    
    MsgBox addCnt & "件追加、" & modifyCnt & "件更新"
End Sub

開いたCSVファイルを「#1」として操作します。

Do Until EOF(1)は、#1のファイル、すなわちsample.csvを上から下まで行ごとに処理するというループです。

まずは1行をstrBufに格納し、カンマで分割して配列strArrに格納していきます。配列の番号は0から始まり、4列分あるのでstrArr(0)~strArr(3)までを使用するということですね。

先頭行は各列の説明ですので取り出す必要はありません。strArr(0)が「JANコード」だったらその行はスキップするようにしています。

あと各データを囲っているダブルクォーテーションが邪魔なのでReplaceで取り除いています。ダブルクォーテーション自体を指定する場合は「””””」と記述します。

こんな感じで16桁以上でも表示することができました。

値にカンマがある場合

しかしおかしなことが起きてますね。5列目に何やら増えています。

この方法では、カンマで区切って配列に格納していくわけですが、値の中にカンマがある場合はそこでもデータを区切ってしまいます。

結果として「G9X MK2,シルバー」が「G9X MK2」「シルバー」の2つに分離してしまっています。

このように値でカンマを扱うようなファイルの場合はもうひと工夫必要です。

サンプルの《カンマ》ボタンに記録されているマクロです。

Sub commaInValue()
    Dim openFileName As String
    Dim rowEnd As Long
    Dim addFlg As Boolean
    Dim setCnt As Long
    Dim modifyCnt As Long
    Dim strBuf As String
    Dim strArr() As String
    Dim i As Long
    
    If Cells(4, 1).Value <> "" Then
        Cells(3, 1).Select
        rowEnd = Selection.End(xlDown).Row
    Else
        Select Case Cells(3, 1).Value
            Case ""
                rowEnd = 2
            Case Else
                rowEnd = 3
        End Select
    End If
    
    If Dir(ThisWorkbook.Path & "\sample.csv") <> "" Then
        openFileName = ThisWorkbook.Path & "\sample.csv"
    Else
        openFileName = Application.GetOpenFilename("CSV(カンマ区切り),*.csv")
        If openFileName = "False" Then
            Exit Sub
        End If
    End If

    Open openFileName For Input As #1
    
    addCnt = 0
    modifyCnt = 0
    
    Do Until EOF(1)
        Line Input #1, strBuf
        If strBuf <> "" Then
            strArr = Split(csvToTsv(strBuf), vbTab)
            
            addFlg = True
            If Replace(strArr(0), """", "") <> "JANコード" Then
                For i = 3 To rowEnd
                    If "'" & Replace(strArr(0), """", "") = "'" & Cells(i, 1).Value Then
                        setRow = i
                        addFlg = False
                        Exit For
                    End If
                Next i
                
                If addFlg = True Then
                    rowEnd = rowEnd + 1
                    setRow = rowEnd
                    addCnt = addCnt + 1
                Else
                    modifyCnt = modifyCnt + 1
                End If
                
                For i = 0 To UBound(strArr)
                    Select Case i
                        Case 0
                            Cells(setRow, i + 1).Value = "'" & Replace(strArr(i), """", "")
                        Case Else
                            Cells(setRow, i + 1).Value = Replace(strArr(i), """", "")
                    End Select
                Next i
            End If
        End If
    Loop
    
    Close #1
    
    MsgBox addCnt & "件追加、" & modifyCnt & "件更新"
End Sub

Function csvToTsv(ByRef str As String) As String
    Dim strTemp As String
    Dim quotCount As Long
    Dim l As Long
    
    For l = 1 To Len(str)
        strTemp = Mid(str, l, 1)
        If strTemp = """" Then
            quotCount = quotCount + 1
        ElseIf strTemp = "," Then
            If quotCount Mod 2 = 0 Then
                str = Left(str, l - 1) & vbTab & Right(str, Len(str) - l)
            End If
        End If
    Next l
    
    csvToTsv = str
End Function

https://tonari-it.com/vba-csv-camma/

参考にしているのはこちらの記事。CSVは”○○○,△△△”,”□□□,×××”のように、ダブルクォーテーションで囲まれているカンマは値としてのカンマ、ダブルクォーテーションの外にあるカンマは区切りとしてのカンマということ。

つまりダブルクォーテーションの外にあるカンマを別の文字列に変換して、その文字列でデータを分ければいいという考えです。

参考にした記事では「:(コロン)」を区切り文字にしているのですが、そうすると値にコロンが含まれている場合に困りますね。

使わない文字列は何かと考えた結果、「vbTab(タブ記号)」に置換することにしました。つまりCSVをTSVファイルとして処理する方法です。

これで16桁以上の数値も表示できて、カンマを含んだデータも正常に区切ることができました。

CSVデータがUTF-8で文字化けする場合

ここまでは文字コードがANSIのCSVファイルを開いてきました。

ではUTF-8のCSVファイルではどうでしょうか。sample.csvの文字コードを変更して保存し直しました。

見事に文字化けしております。ExcelはUTF-8のデータを読み込めないんですね。

https://tonari-it.com/vba-csv-utf8/

そういうわけで、こちらの記事を参考にしてコードを書き直します。ADODB.StreamというオブジェクトにCSVファイルを入れるとUTF-8で扱うことができるとのこと。

サンプルの《文字化け》ボタンに記録されているマクロです。

Sub charUTF8()
    Dim openFileName As String
    Dim rowEnd As Long
    Dim addFlg As Boolean
    Dim setCnt As Long
    Dim modifyCnt As Long
    Dim strBuf As String
    Dim strLine() As String
    Dim strArr() As String
    Dim i As Long
    
    If Cells(4, 1).Value <> "" Then
        Cells(3, 1).Select
        rowEnd = Selection.End(xlDown).Row
    Else
        Select Case Cells(3, 1).Value
            Case ""
                rowEnd = 2
            Case Else
                rowEnd = 3
        End Select
    End If
    
    If Dir(ThisWorkbook.Path & "\sample.csv") <> "" Then
        openFileName = ThisWorkbook.Path & "\sample.csv"
    Else
        openFileName = Application.GetOpenFilename("CSV(カンマ区切り),*.csv")
        If openFileName = "False" Then
            Exit Sub
        End If
    End If
    
    Set adoSt = CreateObject("ADODB.Stream")
    With adoSt
        .Charset = "UTF-8"
        .Open
        .LoadFromFile openFileName
        strBuf = .ReadText
        .Close
    End With

    strLine = Split(strBuf, vbCrLf)
    
    addCnt = 0
    modifyCnt = 0
    
    For i = 1 To UBound(strLine)
        If strLine(i) <> "" Then
            strArr = Split(csvToTsv(strLine(i)), vbTab)
            
            addFlg = True
            For j = 3 To rowEnd
                If "'" & Replace(strArr(0), """", "") = "'" & Cells(j, 1).Value Then
                    setRow = j
                    addFlg = False
                    Exit For
                End If
            Next j
            
            If addFlg = True Then
                rowEnd = rowEnd + 1
                setRow = rowEnd
                addCnt = addCnt + 1
            Else
                modifyCnt = modifyCnt + 1
            End If
            
            For j = 0 To UBound(strArr)
                Select Case j
                    Case 0
                        Cells(setRow, j + 1).Value = "'" & Replace(strArr(j), """", "")
                    Case Else
                        Cells(setRow, j + 1).Value = Replace(strArr(j), """", "")
                End Select
            Next j
        End If
    Next i
 
    MsgBox addCnt & "件追加、" & modifyCnt & "件更新"
End Sub

Function csvToTsv(ByRef str As String) As String
    Dim strTemp As String
    Dim quotCount As Long
    Dim l As Long
    
    For l = 1 To Len(str)
        strTemp = Mid(str, l, 1)
        If strTemp = """" Then
            quotCount = quotCount + 1
        ElseIf strTemp = "," Then
            If quotCount Mod 2 = 0 Then
                str = Left(str, l - 1) & vbTab & Right(str, Len(str) - l)
            End If
        End If
    Next l
    
    csvToTsv = str
End Function

ここまでのものと配列の使い方を変えていまして、CSVファイルのデータをstrBufに入れた後、「vbCrLf(改行)」で区切って配列strLineに格納、そのstrLineをカンマで区切って配列strArrに格納という方法を取っています。

そのためループを1から開始することで、先頭行のstrLine(0)を飛ばすことができます。

このADODB.Streamを使うにはVBEのツール→参照設定から、Microsoft ActiveX Data Objects ○.○ Libraryにチェックを入れる必要があるとのこと。環境設定を変える必要があるのはハードル高めですが仕方がないですね。

以上です。

取り扱うCSVファイルの内容によってコードを使い分けてください。

マクロの制作はクラウドソーシングから

CSVファイルを操作するマクロはVBAの基本を学べますし、実務の効率化にも影響が大きいです。

以上の解説を理解すればたいていのことはできると思いますので是非チャレンジしてみてください。

もしどうしてもわからない人や、もっと複雑なマクロを組みたい人、マクロを組む時間がない人は、ランサーズかクラウドワークスからご依頼ください。

1機能あたり5,000円程度で承ります。お気軽にご相談ください。

https://www.lancers.jp/profile/shimehitsu14

https://crowdworks.jp/public/employees/2337605

コメント