Sub mondai3_Collection()
    Dim dic As New Scripting.Dictionary
    Dim cFm As Long
    For cFm = 2 To 21
        If Range("C" & cFm).Value = "渋谷区" Then
            If Not dic.Exists("渋谷区") Then
                'DictionaryにCollectionオブジェクトを参照させる
                dic.Add "渋谷区", New Collection
            End If
            'Collectionに行番号を入れる
            dic.Item("渋谷区").Add cFm
        End If
    Next

    Dim Var As Variant
    'Collectionから行番号を取り出す
    Debug.Print TypeName(dic.Item("渋谷区"))
    For Each Var In dic.Item("渋谷区")
        Debug.Print Var
        Range("H" & Var).Value = "○"
    Next
End Sub

Sub mondai3_Col1() '数値を格納
    Dim cFm As Long
    Dim col As New Collection
    For cFm = 2 To 21
        If Range("C" & cFm).Value = "渋谷区" Then
            col.Add cFm
        End If
    Next
    Dim v As Variant
    For Each v In col
        Debug.Print v
    Next
End Sub
Sub mondai3_Col2() 'セルへの参照を格納
    Dim cFm As Long
    Dim col As New Collection
    For cFm = 2 To 21
        If Range("C" & cFm).Value = "渋谷区" Then
            col.Add Range("F" & cFm)
        End If
    Next
    Dim v As Variant
    For Each v In col
        Debug.Print v.Address & " : " & v.Value
    Next
End Sub

Sub mondai3_Collection()
    Dim dic As New Scripting.Dictionary
    Dim cFm As Long
    For cFm = 2 To 21
        If Range("C" & cFm).Value = "渋谷区" Then
            If Not dic.Exists("渋谷区") Then
                'DictionaryにCollectionオブジェクトを参照させる
                dic.Add "渋谷区", New Collection
            End If
            'Collectionに行番号を入れる
            dic.Item("渋谷区").Add cFm
        End If
    Next

    Dim Var As Variant
    'Collectionから行番号を取り出す
    Debug.Print TypeName(dic.Item("渋谷区"))
    For Each Var In dic.Item("渋谷区")
        Debug.Print Var
        Range("H" & Var).Value = "○"
    Next
End Sub

Sub mondai4_Col1() '数値を格納
    Dim cFm As Long
    Dim dic As New Scripting.Dictionary
    Dim st As String
    For cFm = 2 To Range("A" & Rows.Count).End(xlUp).Row
        st = Range("C" & cFm).Value
        If Not dic.Exists(st) Then
            dic.Add st, New Collection
        End If
        dic.Item(st).Add cFm
    Next
    
    Dim var As Variant
    Dim cTo As Long
    Dim sp() As String
    cTo = 2
    For cFm = 0 To dic.Count - 1
        st = dic.Keys(cFm)
        Range("J" & cTo).Value = st & "のマンションは" & dic.Item(st).Count & "件ヒットしました！"
        cTo = cTo + 1
        For Each var In dic.Item(st)
            Range("K" & cTo).Value = Range("F" & var).Value
            Range("L" & cTo).Value = Range("D" & var).Value
            Range("M" & cTo).Value = Range("E" & var).Value
            sp = Split(Range("G" & var).Value, "/")
            Range("N" & cTo).Value = sp(0)
            Range("O" & cTo).Value = sp(1)
            cTo = cTo + 1
        Next
        cTo = cTo + 1
    Next
End Sub

'連想配列に動的配列を格納する別解
Sub mondai5_array()

    '初期化
    Dim cMx As Long
    cMx = Range("O" & Rows.Count).End(xlUp).Row
    If cMx > 1 Then
        Range("J2:O" & cMx).ClearContents
    End If
    
    Dim cFm As Long
    Dim dic As New Scripting.Dictionary
    
    Dim st As String
    Dim ar As Variant
    For cFm = 2 To Range("A" & Rows.Count).End(xlUp).Row
        st = Range("C" & cFm).Value
        If Not dic.Exists(st) Then
            dic.Add st, Array(cFm)
        Else
            ar = dic.Item(st)
            ReDim Preserve ar(UBound(ar) + 1)
            ar(UBound(ar)) = cFm
            dic.Item(st) = ar
        End If
    Next
     
    Dim cTo As Long, GYO As Long
    Dim sp() As String
    GYO = 2
    For cFm = LBound(dic.Keys) To UBound(dic.Keys)
        st = dic.Keys(cFm)
        Range("J" & GYO).Value = st & "のマンションは" & UBound(dic.Item(st)) + 1 & "件ヒットしました！"
        GYO = GYO + 1
        
        For cTo = LBound(dic.Item(st)) To UBound(dic.Item(st))
            Range("K" & cTo + GYO).Value = Range("F" & dic.Item(st)(cTo)).Value
            Range("L" & cTo + GYO).Value = Range("D" & dic.Item(st)(cTo)).Value
            Range("M" & cTo + GYO).Value = Range("E" & dic.Item(st)(cTo)).Value
            sp = Split(Range("G" & dic.Item(st)(cTo)).Value, "/")
            Range("N" & cTo + GYO).Value = sp(0)
            Range("O" & cTo + GYO).Value = sp(1)
        Next
        GYO = GYO + UBound(dic.Item(st)) + 2
    Next
End Sub

Sub CompareCSVFiles()
    Dim file1Path As String, file2Path As String
    Dim ws1 As Worksheet, ws2 As Worksheet, wsResult As Worksheet
    Dim lastRow1 As Long, lastRow2 As Long, lastCol As Long
    Dim i As Long, j As Long, resultRow As Long
    Dim key1 As String, key2 As String
    Dim dict1 As Object, dict2 As Object

    Dim fso As Object
    Dim file1Time As Date, file2Time As Date
    
    ' ファイル選択ダイアログ
    file1Path = Application.GetOpenFilename("CSVファイル (*.csv), *.csv", , "1つ目のCSVファイルを選択")
    If file1Path = "False" Then Exit Sub
    
    file2Path = Application.GetOpenFilename("CSVファイル (*.csv), *.csv", , "2つ目のCSVファイルを選択")
    If file2Path = "False" Then Exit Sub

    ' FileSystemObjectを使ってタイムスタンプを取得
    Set fso = CreateObject("Scripting.FileSystemObject")
    file1Time = fso.GetFile(file1Path).DateLastModified
    file2Time = fso.GetFile(file2Path).DateLastModified
    
    ' 既存のシートをクリア、なければ作成
    On Error Resume Next
    Set ws1 = ThisWorkbook.Worksheets("CSV1")
    If ws1 Is Nothing Then Set ws1 = ThisWorkbook.Worksheets.Add
    ws1.Name = "CSV1"
    ws1.Cells.Clear
    
    Set ws2 = ThisWorkbook.Worksheets("CSV2")
    If ws2 Is Nothing Then Set ws2 = ThisWorkbook.Worksheets.Add
    ws2.Name = "CSV2"
    ws2.Cells.Clear
    
    Set wsResult = ThisWorkbook.Worksheets("差分結果")
    If wsResult Is Nothing Then Set wsResult = ThisWorkbook.Worksheets.Add
    wsResult.Name = "差分結果"
    wsResult.Cells.Clear
    On Error GoTo 0
    
    ' CSVファイルを読み込み
    Call LoadCSV(file1Path, ws1)
    Call LoadCSV(file2Path, ws2)
    
    ' 列数を取得
    lastCol = ws1.Cells(1, ws1.Columns.Count).End(xlToLeft).Column
    lastRow1 = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
    lastRow2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row
    
    ' 結果シートにファイル情報を出力
    wsResult.Cells(1, 1).Value = "【比較情報】"
    wsResult.Cells(1, 1).Font.Bold = True
    wsResult.Cells(2, 1).Value = "CSV1:"
    wsResult.Cells(2, 2).Value = fso.GetFileName(file1Path)
    wsResult.Cells(3, 1).Value = "更新日時:"
    wsResult.Cells(3, 2).Value = Format(file1Time, "yyyy/mm/dd hh:nn:ss")
    wsResult.Cells(4, 1).Value = "CSV2:"
    wsResult.Cells(4, 2).Value = fso.GetFileName(file2Path)
    wsResult.Cells(5, 1).Value = "更新日時:"
    wsResult.Cells(5, 2).Value = Format(file2Time, "yyyy/mm/dd hh:nn:ss")
    wsResult.Cells(6, 1).Value = "比較日時:"
    wsResult.Cells(6, 2).Value = Format(Now, "yyyy/mm/dd hh:nn:ss")

    ' 結果シートにヘッダーを作成
    wsResult.Cells(GYO, 1).Value = "状態"
    wsResult.Cells(GYO, 2).Value = "更新検知CSVファイル"
    For j = 1 To lastCol
        wsResult.Cells(GYO, j + 2).Value = ws1.Cells(1, j).Value
    Next j

    ' ヘッダー行を太字に
    wsResult.Rows(GYO).Font.Bold = True
    
    ' Dictionaryオブジェクトを作成（高速検索用）
    Set dict1 = CreateObject("Scripting.Dictionary")
    Set dict2 = CreateObject("Scripting.Dictionary")

    ' 1つ目のCSVをDictionaryに格納
    For i = 2 To lastRow1
        key1 = ws1.Cells(i, 2).Value & ws1.Cells(i, 3).Value
        If key1 <> "" Then
            dict1.Add key1, Array( _
                fso.GetFileName(file1Path), _
                ws1.Cells(i, 1).Value, _
                ws1.Cells(i, 2).Value, _
                ws1.Cells(i, 3).Value)
        End If
    Next i

    ' 2つ目のCSVをDictionaryに格納
    For i = 2 To lastRow2
        key2 = ws2.Cells(i, 2).Value & ws2.Cells(i, 3).Value
        If key2 <> "" Then
            dict2.Add key2, Array( _
                fso.GetFileName(file2Path), _
                ws2.Cells(i, 1).Value, _
                ws2.Cells(i, 2).Value, _
                ws2.Cells(i, 3).Value)
        End If
    Next i
    
    resultRow = GYO + 1

    ' CSV2のデータをチェック（追加）
    Dim vKey
    For Each vKey In dict2.keys
        If Not dict1.Exists(vKey) Then
            ' CSV1に存在しない（追加された）
            wsResult.Cells(resultRow, 1).Value = "追加"
            wsResult.Cells(resultRow, 1).Interior.Color = RGB(200, 255, 200)
            For j = 1 To lastCol + 1
                wsResult.Cells(resultRow, j + 1).NumberFormat = "@"  ' 文字列形式
                wsResult.Cells(resultRow, j + 1).Value = dict2.Item(key2)(j - 1)
            Next j
            resultRow = resultRow + 1
        End If
    Next vKey
    
    ' CSV1のデータをチェック（削除）
    For Each vKey In dict1.keys
        If Not dict2.Exists(vKey) Then
            ' CSV2に存在しない（削除された）
            wsResult.Cells(resultRow, 1).Value = "削除"
            wsResult.Cells(resultRow, 1).Interior.Color = RGB(255, 200, 200)
            For j = 1 To lastCol + 1
                wsResult.Cells(resultRow, j + 1).NumberFormat = "@"  ' 文字列形式
                wsResult.Cells(resultRow, j + 1).Value = dict1.Item(key1)(j - 1)
            Next j
            resultRow = resultRow + 1
        End If
    Next vKey

    ' 列幅を自動調整
    wsResult.Columns.AutoFit

    ' 結果を表示
    wsResult.Activate
    MsgBox "差分抽出が完了しました。" & vbCrLf & _
           "結果は「差分結果」シートに出力されています。", vbInformation
End Sub

' CSVファイルを読み込む関数（0落ち対策版）
Private Sub LoadCSV(filePath As String, targetWs As Worksheet)
    Dim fileNo As Integer
    Dim lineText As String
    Dim dataArray() As String
    Dim r As Long, c As Long
    Dim cellValue As String
    
    fileNo = FreeFile
    r = 1
    
    Open filePath For Input As #fileNo
    
    Do Until EOF(fileNo)
        Line Input #fileNo, lineText
        dataArray = Split(lineText, ",")
        
        For c = 0 To UBound(dataArray)
            cellValue = Trim(dataArray(c))
            
            ' 0で始まる数値の場合、文字列として設定
            If Left(cellValue, 1) = "0" And Len(cellValue) > 1 And IsNumeric(cellValue) Then
                targetWs.Cells(r, c + 1).NumberFormat = "@"  ' 文字列形式
                targetWs.Cells(r, c + 1).Value = cellValue
            Else
                targetWs.Cells(r, c + 1).Value = cellValue
            End If
        Next c
        
        r = r + 1
    Loop
    
    Close #fileNo
End Sub

key1 = ws1.Cells(i, 2).Value & "|" & ws1.Cells(i, 3).Value

key1 = Join(Array(ws1.Cells(i, 2).Value, ws1.Cells(i, 3).Value), "|")

cellValue = Trim(Replace(dataArray(c), """", ""))
'cellValue = Trim(dataArray(c))