같은 내용끼리 셀병합

별거 없다.

달력을 순환하면서

같은 내용끼리 병합하는 매크로

빈셀마다 ‘ 가 붙어있고 셀색이 조건부서식으로 되어있는 것만 주의하면 됨

Sub rngMerge()
 
    Dim rnG As Range
    Dim rngData As Range
    Dim i As Byte
 
    '작업속도 향상
    Application.ScreenUpdating = False
 
    '데이터 영역 설정
    Set rngData = Range("A1").CurrentRegion
    With rngData
        Set rngData = .Offset(5, 1).Resize(.Rows.Count - 5, .Columns.Count - 1)
    End With
 
    For Each rnG In rngData
        With rnG
 
            ' '가 셀마다 있어서 '가 있는 부분과 없는 부분을 구분해서 작업
            '조건부서식으로 셀색깔이 입혀져있어서 셀 색으로는 구분 안 됨
            If Len(.Value) Then
 
                '병합할 영역 더하기
                If .Value = .Offset(, 1) Then
                    i = i + 1
 
                '셀병합 후 가운데 정렬
                Else
                    Application.DisplayAlerts = False
                        With Range(.Cells, .Offset(, -i))
                            .Merge
                            .HorizontalAlignment = xlCenter
                        End With
                    Application.DisplayAlerts = True
                    i = 0
                End If
            End If
        End With
    Next rnG
 
    Application.ScreenUpdating = True
 
End Sub

셀병합질문_카페.xlsm