셀병합된 영역의 합계 구하기 (엑셀 VBA 매크로)

매크로 실행 전                                                     매크로 실행 후 결과

Option Explicit
Sub sum_Of_Merge_Area()
    Dim r As Long                                              '행(r)ow 늘려갈 변수
    Dim cntArea As Long                                    '셀병합 영역(Area)의 셀 개수(c)ou(nt) 넣을 변수
   
    Application.ScreenUpdating = False                '화면 업데이트 (일시)정지
   
    r = 2                                                            '2행부터 시작
   
    Do                                                              '실행
        Cells(Rows.Count, "D").End(3)(2) = Cells(r, 1)   '종단셀 D열 윗방향 바로 아래셀에 제목
       
        If Cells(r, 1).MergeCells Then                    '셀병합 되어 있다면
       
            cntArea = Cells(r, 1).MergeArea.Cells.Count    '셀병합 영역의 셀 개수를 변수에 넣음
           
            Cells(Rows.Count, "E").End(3)(2) = _
                Application.Sum(Cells(r, 1).Offset(, 1).Resize(cntArea))
                    '셀병합셀 개수만큼 B열의 영역합을 구하여 종단셀 E열 윗방향 바로 아래셀에 값

​
            r = r + cntArea - 1                                 '행 + 셀병합 영역 셀개수 - 1 만큼 행 늘려감
        Else                                                       '셀병합 안되어 있으면
            Cells(Rows.Count, "E").End(3)(2) = Cells(r, 2)  '종단셀 E열 윗방향 바로 아래셀에 값
        End If
       
        r = r + 1                                                   '행을 1씩 늘려감
    Loop Until IsEmpty(Cells(r, 2))                       'B열에 빈셀 나올때까지 무한 반복
End Sub

[출처] (1791) 셀병합된 영역의 합계 구하기 (엑셀 VBA 매크로)|작성자 니꾸