Sub mergeCells()
Dim i As Integer
Dim rngStart As Range
Dim rngEnd As Range
'선택된 영역 중 첫째줄 지정
Set rngStart = Selection.Cells(2, 2)
'선택된 영역 반복
For i = 2 To Selection.Rows.Count
'두줄을 비교하여 같지 않을 경우
If Selection.Cells(i, 2) <> Selection.Cells(i + 1, 2) Then
'같지 않을 경우 끝으로 지정
Set rngEnd = Selection.Cells(i, 2)
'알람 창 Off
Application.DisplayAlerts = False
'셀 병합 실시
Range(rngStart, rngEnd).Merge
'중앙 정렬
Range(rngStart, rngEnd).HorizontalAlignment = xlCenter
Range(rngStart, rngEnd).VerticalAlignment = xlCenter
'알람 창 On
Application.DisplayAlerts = True
'시작 위치를 다음 줄로 설정
Set rngStart = Selection.Cells(i + 1, 2)
End If
Next
End Sub
'VBA CODE' 카테고리의 다른 글
| VBA end(3)(2) end(xlup) end(3) end(1) end(2) end(4) (0) | 2023.03.31 |
|---|---|
| VBA 처리 속도 높이는 코드 (0) | 2023.03.31 |
| VBA 범위 설정 셀 설정 Range Cells (0) | 2023.03.31 |
| VBA 빈행과 빈셀 A열 삭제하는 방법 코드 (0) | 2023.03.31 |
| VBA 마지막값 , 마지막행 마지막열 찾기 (0) | 2023.03.31 |