ExcelVBAでCSVの先頭列を集計と重複削除後のサマリ

# 経緯
手作業でCSVの1列目の項目で集計して欲しいと言われたので手作業したくないからVBAを作成。
ついでに１から3列目までの情報を基に重複を削除する。
重複しているものをサマリしてカウントする。
そんな感じのソースを3つ作った。
（もう少し改良すれば汎用的に使える気がする・・・。）

# 使用用途</summary>
CSVファイルの集計をしたい。
複数CSVに分かれてる同じような内容をまとめて収集したいなど

<details><summary>テスト時のCSVの中身</summary>
山田,12358,6759966<br>
山田,12358,6789566<br>
山田,12358,6789956<br>
山田,12358,6789966<br>
山田,12368,6789966<br>
山田,12558,6789966<br>
山田,15358,6789966<br>
田中,12358,7759966<br>
田中,12358,7789566<br>
田中,12358,7789956<br>
田中,12358,7789966<br>
田中,12368,7789966<br>
田中,12558,7789966<br>
田中,15358,7789966<br>
田中,12358,7789966<br>
二郎,12368,7789966<br>
二郎,12558,7789966<br>
二郎,15358,7789966<br>
二郎,12358,7789566<br>
二郎,12358,7789956<br>
二郎,12358,7759966<br>
山田,12358,6789966<br>
熊田隈,12368,6789966<br>
熊田隈,12558,6789966<br>
熊田隈,15358,6789966<br>
熊田隈,12358,6789566<br>
山田,12358,6789956<br>
山田,12358,6759966<br>
</details>


#### Excelファイル1シート目のA2から下に記述されているCSVファイルのパスを基に集計を行う。
```SummarizeData
Sub CountItemsFromCSV()
    Dim ws As Worksheet
    Dim rowCount As Long
    Dim i As Integer
    Dim j As Integer
    Dim key As Variant
    Dim counts As Object
    Dim filePath As String
    Dim currentValue As Variant
    Dim currentCount As Long
    
    ' シートを取得
    Set ws = ThisWorkbook.Sheets("Sheet1") ' シート名を適宜変更してください
    
    ' 初期化
    Set counts = CreateObject("Scripting.Dictionary")
    
    ' ファイルごとに処理
    j = 2 ' シート上での開始行
    Do While ws.Cells(j, 1).Value <> "" ' シート上で空白行に到達するまで繰り返す
        ' ファイルパスを取得
        filePath = ws.Cells(j, 1).Value
        
        ' ファイルを開く
        Open filePath For Input As #1
        
        ' 各数値の出現回数を集計
        Do While Not EOF(1)
            Line Input #1, key
            currentValue = Split(key, ",")(0) ' 最初の要素をキーとする
            If Not counts.Exists(currentValue) Then
                counts.Add currentValue, 1
            Else
                counts(currentValue) = counts(currentValue) + 1
            End If
        Loop
        
        ' ファイルを閉じる
        Close #1
        
        ' 次の行に移動
        j = j + 1
    Loop
    
    ' 結果をシートに出力
    ws.Range("D2").Resize(counts.Count, 2).Value = WorksheetFunction.Transpose(Array("Value", "Count"))
    j = 2
    For Each key In counts.Keys
        ws.Cells(j, 4).Value = key
        ws.Cells(j, 5).Value = counts(key)
        j = j + 1
    Next key
End Sub
```
表示結果
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3758592/c833e66d-d6ae-074c-398e-89746a37696c.png)

#### CSVの1から3列目の情報をシート生成して表示する。
```RemoveDuplicatesFromCSV
Sub RemoveDuplicatesFromCSV()
    Dim ws As Worksheet
    Dim newWs As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim key As Variant
    Dim uniqueValues As Object
    Dim filePath As String
    Dim currentValue As Variant
    Dim csvData As Variant ' CSVデータを保持する配列
    
    ' 新しいシートを作成
    Set newWs = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        newWs.Name = "Data_" + Format(Now(), "YYYYMMDD_HHMMSS")
    
    ' シートを取得
    Set ws = ThisWorkbook.Sheets("Sheet1") ' シート名を適宜変更してください
    
    ' 初期化
    Set uniqueValues = CreateObject("Scripting.Dictionary")
    
    ' 最終行を取得
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' CSVファイルのデータを重複なしでコピー
    For i = 2 To lastRow
        ' ファイルパスを取得
        filePath = ws.Cells(i, 1).Value
        
        ' CSVファイルのデータを配列に読み込む
        csvData = LoadCSVData(filePath)
        
        ' CSVのデータを重複なしでコピー
        For j = LBound(csvData, 1) To UBound(csvData, 1)
            key = csvData(j, 1) & "-" & csvData(j, 2) & "-" & csvData(j, 3)
            If Not uniqueValues.Exists(key) Then
                uniqueValues.Add key, csvData(j, 1) & "," & csvData(j, 2) & "," & csvData(j, 3)
            End If
        Next j
    Next i
    
    ' 結果を新しいシートに出力
    newWs.Range("A1").Value = "Column1"
    newWs.Range("B1").Value = "Column2"
    newWs.Range("C1").Value = "Column3"
    i = 2
    For Each key In uniqueValues.Keys
        currentValue = Split(uniqueValues(key), ",")
        newWs.Cells(i, 1).Value = currentValue(0)
        newWs.Cells(i, 2).Value = currentValue(1)
        newWs.Cells(i, 3).Value = currentValue(2)
        i = i + 1
    Next key
End Sub

Function LoadCSVData(filePath As String) As Variant
    Dim data As String
    Dim dataArray() As String
    Dim result() As Variant
    Dim rowNum As Long
    Dim colNum As Long
    Dim i As Long
    Dim j As Long
    
    Open filePath For Input As #1
    Do Until EOF(1)
        Line Input #1, data
        dataArray = Split(data, ",")
        rowNum = rowNum + 1
        colNum = UBound(dataArray) + 1
    Loop
    Close #1
    
    ReDim result(1 To rowNum, 1 To colNum)
    
    rowNum = 0
    Open filePath For Input As #1
    Do Until EOF(1)
        Line Input #1, data
        dataArray = Split(data, ",")
        rowNum = rowNum + 1
        For j = 1 To colNum
            result(rowNum, j) = dataArray(j - 1)
        Next j
    Loop
    Close #1
    
    LoadCSVData = result
End Function

```
表示結果
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3758592/695380a8-d2fa-e261-d7c3-2812d09663b1.png)
※長いので割愛


#### 重複データを削除した状態の件数を取得する。
```Summary
Sub SummarizeData()
    Dim ws As Worksheet
    Dim newWs As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim key As Variant
    Dim uniqueValues As Object
    Dim filePath As String
    Dim currentValue As Variant
    Dim csvData As Variant ' CSVデータを保持する配列
    Dim summaryCounts As Object ' サマリーカウントを保持するオブジェクト
    
    ' 新しいシートを作成
    Set newWs = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    newWs.Name = "Summary" + Format(Now(), "YYYYMMDD_HHMMSS")
    
    ' シートを取得
    Set ws = ThisWorkbook.Sheets("Sheet1") ' シート名を適宜変更してください
    
    ' 初期化
    Set uniqueValues = CreateObject("Scripting.Dictionary")
    Set summaryCounts = CreateObject("Scripting.Dictionary")
    
    ' 最終行を取得
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' CSVファイルのデータを重複なしでコピー
    For i = 2 To lastRow
        ' ファイルパスを取得
        filePath = ws.Cells(i, 1).Value
        
        ' CSVファイルのデータを配列に読み込む
        csvData = LoadCSVData(filePath)
        
        ' CSVのデータを重複なしでコピー
        For j = LBound(csvData, 1) To UBound(csvData, 1)
            key = csvData(j, 1) & "-" & csvData(j, 2) & "-" & csvData(j, 3)
            If Not uniqueValues.Exists(key) Then
                uniqueValues.Add key, csvData(j, 1) & "," & csvData(j, 2) & "," & csvData(j, 3)
                
                ' サマリーカウントを更新
                If Not summaryCounts.Exists(csvData(j, 1)) Then
                    summaryCounts.Add csvData(j, 1), 1
                Else
                    summaryCounts(csvData(j, 1)) = summaryCounts(csvData(j, 1)) + 1
                End If
            End If
        Next j
    Next i
    
    ' サマリーを新しいシートに出力
    newWs.Range("A1").Value = "Column1"
    newWs.Range("B1").Value = "Count"
    i = 2
    For Each key In summaryCounts.Keys
        newWs.Cells(i, 1).Value = key
        newWs.Cells(i, 2).Value = summaryCounts(key)
        i = i + 1
    Next key
End Sub

Function LoadCSVData(filePath As String) As Variant
    Dim data As String
    Dim dataArray() As String
    Dim result() As Variant
    Dim rowNum As Long
    Dim colNum As Long
    Dim i As Long
    Dim j As Long
    
    Open filePath For Input As #1
    Do Until EOF(1)
        Line Input #1, data
        dataArray = Split(data, ",")
        rowNum = rowNum + 1
        colNum = UBound(dataArray) + 1
    Loop
    Close #1
    
    ReDim result(1 To rowNum, 1 To colNum)
    
    rowNum = 0
    Open filePath For Input As #1
    Do Until EOF(1)
        Line Input #1, data
        dataArray = Split(data, ",")
        rowNum = rowNum + 1
        For j = 1 To colNum
            result(rowNum, j) = dataArray(j - 1)
        Next j
    Loop
    Close #1
    
    LoadCSVData = result
End Function

```
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3758592/372c6a22-0725-73b3-bda4-46402792f740.png)


<br>
だいぶ突貫工事で作ったソースだけど動作的には問題なし。
強いて言うなら一番上のソースが1シート目にデータを書きだしている事、他と同じで別シートを作るようにすればよかった。

改良すれば他の目的にも使えそうな気もする。