메뉴
미해결 M365윈도우11

엑셀 내에서 이런 식의 작업도 가능할지 질문 드립니다.

듀다다다
8월 6일 조회 745


위 이미지와 같이 번호1이 같은 행들이 있습니다. 같은 번호1을 가진 행들 내에서 A를 기준으로 나머지 B, C, D 등과 그에 딸린 번호2를 아래 이미지와 같이 정렬하고 싶은 상황입니다. 이런 경우에 쓸 수 있는 함수나 VBA코드가 있을까요?



 

제가 엑셀 초짜라... 보통은 GPT를 활용해서 대부분 해결했는데 이 정도로 복잡한 건 자꾸 VBA 코드 컴파일 오류(외부 프로시저 관련이라고는 하는데, 어디가 문제인지 모르겠음)가 뜹니다. 데이터가 몇만 행이 넘는 상황이라 수동으로 수정하는 것도 불가능합니다. ㅠ.ㅠ

잘 아시는 분들의 고견을 기다립니다.

감사합니다.

댓글 10

더블유에이 8월 6일
유첨파일 참고하십시오
듀다다다 작성자 8월 6일
@더블유에이 님 GPT 코드보다 훨씬 간단하네요. 원 데이터에 응용해서 적용해 보겠습니다. 더블유에이님 감사합니다! 
찬바람 8월 6일
AI에게 몇 번의 요청을 통해 받은 답변입니다.
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

 
듀다다다 작성자 8월 6일
@찬바람 님 원 데이터에 맞게 코드를 수정하려고 했는데 제 능력 부족으로 완벽하게 적용하지는 못했습니다... ㅠㅠ 그래도 시간 내주셔서 감사합니다!
찬바람 8월 7일
@듀다다다 님 몇 단계의 수정을 거쳐서 받은 코드인데, 더블유에이님의 결과를 지나쳐서 나온 것입니다. 
AI는 원하는 결과가 나오지 않으면 수정에 수정을 거쳐야 됩니다.
e
exceller1 8월 6일
2021버전이라서 파워쿼리로 해봤습니다.
 
듀다다다 작성자 8월 6일
@exceller1 님 파워쿼리는 한 번도 안 써봤는데 좋은 공부가 되었습니다. 감사합니다! 
마법의손 8월 6일
삭제된 댓글입니다.
듀다다다 작성자 8월 6일
@마법의손 님 원본 데이터에 맞게 코드를 수정하는 일이 쉽지 않네요... AJ열을 넘어가는 큰 데이터라 ㅠㅠ 귀한 시간 내어 같이 고민해 주셔서 정말 감사합니다. 좋은 하루 되세요! 
쌈타 8월 8일
아래 그림처럼 수식 만들어 보세요.
첨부파일 참고하세요

질문답변 게시판의 최근 글

스크랩 완료