Sub 요약정리_번호1유지_첫행고정()

    Dim ws As Worksheet
    Set ws = ActiveSheet

    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row

    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

    Dim i As Long
    For i = 2 To lastRow
        Dim key As Variant
        key = ws.Cells(i, "D").value
        
        Dim value As String
        value = ws.Cells(i, "E").value & "," & ws.Cells(i, "F").value
        
        If Not dict.exists(key) Then
            dict.Add key, Array(i, Array())  ' 첫 행 저장, 값은 비워둠
        Else
            Dim arr As Variant
            arr = dict(key)
            
            Dim tempArr As Variant
            tempArr = arr(1)
            
            Dim newSize As Long
            If IsArray(tempArr) Then
                newSize = UBound(tempArr) + 1
                ReDim Preserve tempArr(newSize)
            Else
                ReDim tempArr(0)
                newSize = 0
            End If
            
            tempArr(newSize) = value
            
            arr(1) = tempArr
            dict(key) = arr
        End If
    Next i

    ' 결과 붙여넣고 기존 값 지우기 (E, F만)
    Dim keyItem As Variant
    For Each keyItem In dict.Keys
        Dim baseRow As Long
        baseRow = dict(keyItem)(0)
        
        Dim values As Variant
        values = dict(keyItem)(1)
        
        Dim j As Long
        For j = 0 To UBound(values)
            Dim parts() As String
            parts = Split(values(j), ",")
            ws.Cells(baseRow, 7 + j * 2).value = parts(0)  ' 알파벳
            ws.Cells(baseRow, 8 + j * 2).value = parts(1)  ' 번호2
        Next j

        ' 나머지 행의 E, F만 지우기
        For i = baseRow + 1 To lastRow
            If ws.Cells(i, "D").value = keyItem Then
                ws.Range("E" & i & ":F" & i).ClearContents
            End If
        Next i
    Next keyItem

    MsgBox "요약 완료! 번호1은 유지되고 첫 행은 그대로입니다."

End Sub