[엑셀, VBA] 동일 값의 셀 병합하기, 비어있지 않은 셀에서 페이지 나누기

동일 값의 셀 병합하기 (출처: http://www.iexceller.com/)

[표1]처럼 되어있는 것을 [표2]처럼 바꾸는 것입니다. (반대방향으로 (표2에서 표1로) 바꾸는 것은 이전에 올린 글을 참고하세요.)

매번 긁기가 귀찮아서 파일로 만들었습니다^^;

samecellmerge.txt

Sub SameCellMerge()
    Dim rngTarget As Range
    Dim rngCell As Range
    Dim strAddress As String
    Dim intNum As Long
    Dim intCount As Long
    Dim intTemp2 As Long
    Dim intTemp As Long
    Dim i As Integer
    Application.DisplayAlerts = False
    On Error GoTo ET
'    strAddress = [Branch].Address
' 이 줄은 원래 있었습니다만 계속 에러가 나길래 주석처리했더니 제대로 작동하였습니다.
    Set rngTarget = Application.InputBox("대상 영역을 선택하세요", "영역 선택", Type:=8, Default:=strAddress)
    intNum = rngTarget.Cells.Count
    ' 사용자로부터 대상 영역을 입력받습니다. 편의상 지점명 부분에 Branch라는 이름을 미리
    ' 정의해 두고 사용하였습니다. 그리고 선택된 영역의 셀 수를 카운팅하여 intNum 변수에
    ' 담아 둡니다.
 
    For Each rngCell In rngTarget
        intTemp = intTemp + 1
        intTemp2 = intNum - intTemp
        ' 현재 셀의 위에 있는 셀(들)들을 검색하기 위해 여러 가지 변수들을 활용하였습니다.
        ' 하나의 셀에 대한 검색이 끝날 때마다 검색해야 할 대상 셀이 하나씩 줄어들게 되므로
        ' 어떤 변수는 값이 증가하는 반면, 또다른 변수는 값이 차례로 줄어듭니다.

        ' 아래의 구문에서도 마찬가지입니다. 눈으로만 보지 말고 종이를 한장 펼쳐놓고 각 변수의
        ' 값을 차례로 대입시켜 보면 쉽게 이해가 되실 것입니다.
          
        If Len(rngCell) > 0 Then
            i = 0
            For intCount = 1 To intTemp2
                If rngCell.Offset(intCount, 0) = rngCell Then
                    i = i + 1
                Else
                    Exit For
                End If
            Next intCount
            If i > 0 Then Range(rngCell, rngCell.Offset(i, 0)).Merge
            ' I 변수의 값이 0보다 크다는 말은 같은 값이 하나 이상 있다는 의미입니다. 이런 경우에만
            ' Merge 메서드를 사용하여 셀을 병합합니다.

        End If
    Next rngCell
    rngTarget.VerticalAlignment = xlCenter
    Application.DisplayAlerts = True
    Exit Sub
ET:
    MsgBox "영역 선택이 잘못되었습니다. 영역을 다시 선택하세요!", , "에러 번호: " & Err.Number
End Sub

다음은,
비어있지 않은 셀에서 페이지 나누기입니다.

위의 작업을 통해 같은 값의 셀을 병합하였는데, 페이지가 중간에 짤렸습니다. 병합된 곳이 만나는 부분에서 페이지 나누기를 하려고 합니다. 단축키 Alt-I-B를 누르면 페이지가 현재 커서가 있는 자리에서 나뉘어지고, Ctrl+아래화살표 를 하면 다음 병합된 곳으로 이동하니까, 이 두 가지의 단축키를 계속 반복하면 됩니다만, 귀찮지요. 그래서 자작한 매크로입니다.

Sub pgbreak()

Dim r As Range

Set r = Range("A3") '1행은 제목행, 2행부터 데이터시작이므로 3행부터 페이지나누기가 들어감

If r.MergeCells Then Set r = r.Offset(1) 'A3셀이 병합된 셀이면 그 다음셀로

Do

 ActiveSheet.HPageBreaks.Add Before:=r   '페이지 나누기 넣기

 Set r = r.Offset(1) '다음 셀로 이동

Loop Until r = "" '이동한 셀이 빈칸일때까지 반복

End Sub

제가 만든게 아무래도 엉성하지요. ㅋ 그래도 방과후학교 출석부 만드는 정도의 작업은 충분히 할 수 있을 겁니다.