【エクセルマクロ】重複データから最大値を抽出：作業効率アップ

Sub 重複データから一番大きい数値を取り出す()

Dim DicName, DicCount, myKey As Variant
Dim i, j As Long
Dim Cnt, Ten As Long
Dim GetName As String

    '連想配列
    Set DicName = CreateObject("Scripting.Dictionary")
    Set DicCount = CreateObject("Scripting.Dictionary")

    '2～最終行までループ
    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row

        '値を変数へ
        GetName = Cells(i, 1)

        '重複しないリストを連想配列へ
        If Not DicName.Exists(GetName) Then
            DicName.Add GetName, GetName
        Else
            '重複しているリストを連想配列へ
            If Not DicCount.Exists(GetName) Then
                 DicCount.Add GetName, GetName
            End If
        End If
    Next i

    myKey = DicCount.keys
    Cnt = 2

    '重複しているリストをループ
    For i = 0 To UBound(DicCount.items)

        Ten = 0

        For j = 1 To Cells(Rows.Count, 1).End(xlUp).Row
            If Cells(j, 1) = myKey(i) Then

                '数値を比較
                If Ten < Cells(j, 2) Then
                    Ten = Cells(j, 2)
                End If
            End If
        Next j

        '最大値を転記
        Cells(Cnt, 4) = myKey(i)
        Cells(Cnt, 5) = Ten
        Cnt = Cnt + 1
    Next i

End Sub