일정 합이 될 때마다 표시하기

Step 1: 결과 미리 보기

WorkPlace 시트로 가서 버튼을 눌러 보세요. 합계가 900000이 넘을 때마다 그림과 같이 표시가 됩니다.

아이엑셀러

만약 이것을 손으로 한다고 생각해 보세요. 아마도 눈과 손이 무진장 피곤할 것입니다.

Step 2: 기본 코드 살펴보기

코드는 몇 줄 되지도 않습니다. Range 오브젝트에 어떻게 여하히 접근하느냐가 관건입니다.

Sub MakeEveryNSum()
    Dim rngStart As Range
    Dim lngSum As Long
    Dim lngSum1 As Long
    Dim r As Long
    Dim shtSource As Worksheet
    Set shtSource = Worksheets("WorkPlace")
    Set rngStart = shtSource.[A1]

    Do
        With rngStart
            lngSum = lngSum + .Offset(r, 0)
            ' Do~Loop 문을 이용하여 순환을 합니다. 한 셀씩 밑으로 내려가면서 값을
            ' lngSum 이라는 변수에 차곡차곡 담아둡니다.

            If lngSum >= 900000 Then
            ' 그러다가 900000이 넘어가면 아래의 문장을 실행합니다.
                .Offset(r + 1, 0).EntireRow.Insert
                .Offset(r, 0).Interior.ColorIndex = 3

                lngSum1 = lngSum - 900000
                .Offset(r + 1, 0) = lngSum1
                .Offset(r, 0) = .Offset(r, 0) - lngSum1
                ' 이 부분이 중요합니다. 셀 값들을 더해서 900000이 넘게 되면 총 합계에서
                ' 900000을 뺀 다음 lngSum1 이라는 변수에 담습니다. 그래야 남는 값을
                ' 이용하여 다음 셀에 있는 값과 계속 더해 줄 수 있으니까요.

                lngSum = 0
                lngSum1 = 0
            End If
            r = r + 1
        End With
    Loop While rngStart.Offset(r, 0) <> ""
    r = 0
    [A1].Select
End Sub

누적 합계가 900000 이상이 되는 셀에서는 초과분(lngSum1)을 계산하여 그 아래에 새 행을 삽입하고, 삽입한 셀에 초과분을 넣은 뒤 원래 셀은 초과분만큼 줄여 정확히 900000이 되도록 만들어 빨간색으로 표시합니다. 그러면 남는 값이 다음 구간의 합계 계산으로 자연스럽게 이어집니다.

Step 3: 합계 기준을 입력받도록 개선하기

합계 기준을 900000으로만 고정해 두면 재미가 없으니 조금 더 융통성 있게 바꿔 보겠습니다. 사용자가 합계 기준을 입력하면 그 기준대로 합산이 되도록 하는 것입니다.

코드를 보면... 약간 수정되었습니다. 위의 코드를 이해 하신다면 전혀 어려운 부분이 없을 것입니다.

Sub MakeEveryNSum2()
    Dim rngStart As Range
    Dim lngSum As Long
    Dim lngSum1 As Long
    Dim lngCriteria As Long
    Dim r As Long
    Dim shtSource As Worksheet
    MakeData
    Set shtSource = Worksheets("WorkPlace2")
    Set rngStart = shtSource.[A1]

    lngCriteria = Val(InputBox("얼마마다 합계를 구할까요?" & vbCr & _
        "(100,000~1,000,000 사이의 값을 입력하세요)"))
    If lngCriteria < 100000 Or lngCriteria > 1000000 Then
        MsgBox "입력하신 기준이 적합하지 않습니다. 다시 확인하세요"
        Exit Sub
    End If

    Do
        With rngStart
            lngSum = lngSum + .Offset(r, 0)
            If lngSum >= lngCriteria Then
                .Offset(r + 1, 0).EntireRow.Insert
                With .Offset(r, 0)
                    .Interior.ColorIndex = 3
                    .Font.ColorIndex = 2
                End With

                lngSum1 = lngSum - lngCriteria
                .Offset(r + 1, 0) = lngSum1
                .Offset(r, 0) = .Offset(r, 0) - lngSum1
                lngSum = 0
                lngSum1 = 0
            End If
            r = r + 1
        End With
    Loop While rngStart.Offset(r, 0) <> ""
    r = 0
    [A1].Select
    MsgBox "작업을 완료하였습니다", , "작업 종료//www.iExceller.com"
End Sub

Sub MakeData()
    ' 실습용으로 WorkPlace2 시트의 A1:A1000에 임의의 숫자를 채웁니다.
    Dim i As Long
    With Worksheets("WorkPlace2")
        .Cells.Clear
        Randomize
        For i = 1 To 1000
            .Cells(i, 1).Value = Int(Rnd * 100000) + 1
        Next i
    End With
End Sub

많이 응용해 보시기 바랍니다.

다음 시간에 또...

정리 — 일정 합계 표시 핵심

자주 묻는 질문 (FAQ)

마치며

Range 오브젝트에 어떻게 접근하느냐가 관건이며, 기준값을 입력받도록 하면 다양한 상황에 응용할 수 있습니다.