거래처번호 기준으로 셀병합 후 부분합

지식인에 올라온 질문.

거래처번호를 기준으로 셀병합을 하고 거래처별 부분합을 넣고 싶다는 글.

부분합을 입력하기 위한 셀삽입을 위해 표 밑에서 위로 올라가며 for 구문을 이용한 것 말고는 특별한 것이 없는 매크로

Option Explicit
 
Sub Macro()
 
    Dim i As Integer, j As Integer
    Dim cntR As Integer, cntC As Integer
    Dim rngData As Range
    Dim sumGold As Long
    Dim k As Integer
    
    '처리속도 향상
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    '기존자료 삭제 후 sheets(2)에 붙여넣기
    With Sheets(2)
        .UsedRange.Delete
        Sheets(1).UsedRange.Copy .Range("A1")
        .Activate
    End With
    
    '표 영역 및 표 행수 열수 지정
    Set rngData = Range("A4").CurrentRegion
    cntR = rngData.Rows.Count + 2
    cntC = rngData.Columns.Count
    j = 1
    
    '거래처번호를 역으로 순환하며 작업
    For i = cntR To 5 Step -1
        
        '거래처번호가 다르면
        If Cells(i, "E") <> Cells(i - 1, "E") Then
            
            '빈셀 삽입 후 부분합 입력
            Cells(i, "A").Resize(, cntC).Insert shift:=xlDown
            sumGold = sumGold + Cells(i + 1, "J")
            
            '부분합 숫자 입력 후 셀서식 지정
            With Cells(i + j + 1, "H")
                .Value = "계"
                .Offset(, 1) = j & "건"
                With .Offset(, 2)
                    .Value = sumGold
                    .Font.Bold = True
                End With
                With .Resize(, 2)
                    .Font.Bold = True
                    .HorizontalAlignment = xlCenter
                End With
            End With
            
            '거래처번호별 셀병합
            With Application
                .DisplayAlerts = False
                For k = 1 To 7
                    Range(Cells(i + 1, k), Cells(i + j + 1, k)).Merge
                Next k
            
                Range(Cells(i + 1, "K"), Cells(i + j + 1, "K")).Merge
                .DisplayAlerts = True
            End With
                        
            '부분합 및 행수 초기화
            sumGold = 0
            j = 1
        
        '거래처번호가 같을 때 금액 및 행수 더하기
        Else
            j = j + 1
            sumGold = sumGold + Cells(i, "J")
        End If
    Next i
    
    '5행 삭제 후 서식 지정
    Rows(5).Delete
    With Range("A4").CurrentRegion
        .Columns.AutoFit
        .Columns("J").NumberFormat = "#,###"
    End With
    
    Range("A4").Resize(cntR, cntC).Borders.Weight = 2
    
    '처리속도 복구
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub

거래처 관리부.xlsm