[엑셀] 셀 병합 매크로 만들기
동기
엑셀에서 셀 병합을 단축키로 하고 싶었는데, 찾아도 잘 나오질 않는다.
방법이 없는 것인지 잘 모르겠지만, 그래서 더 찾아보니 선택한 셀 안에 동일한 값이 들어있으면 셀을 병합해주는 스크립트가 있었다.
방법
1. 메뉴바에 '보기'탭에서 '매크로'를 선택한 뒤에 '매크로 보기'를 클릭한다.
2. 매크로 이름에 아무거나 입력해주면 '만들기' 버튼이 활성화되는데, '만들기' 버튼을 클릭한다.
3. 새로운 창이 뜨게 되는데, 그 창 안에 아무렇게 입력한 이름으로 함수가 만들어지게 되는데, 전체선택(ctrl+a)한 뒤에 아래 스크립트를 붙여넣는다.
Sub MergeMacro()
' 선택 영역에서 인접 셀에 같은 값이 있는 경우 셀을 병합함' If Selection.Cells.Count < 2 Then MsgBox "작업할 범위를 먼저 선택하세요"
Exit Sub
End If
Dim iRow As Integer, iCol As Integer, tR As Integer, tC As Integer, sVal As String Dim rMax As Integer, cMax As Integer, iCount As Integer, cSave As Integer
Application.DisplayAlerts = False Application.ScreenUpdating = False
iRow = Selection.Cells(1).Row: iCol = Selection.Cells(1).Column
cSave = iCol
rMax = Selection.Cells(Selection.Cells.Count).Row cMax = Selection.Cells(Selection.Cells.Count).Column
tR = 0: tC = 0: iCount = 0
Do While iRow <= rMax
sVal = Cells(iRow, iCol)
' 현재 셀이 병합 셀이 아닌경우' If Cells(iRow, iCol).Cells.Count = 1 And Trim(Cells(iRow, iCol)) <> "" Then ' 우측 연속 셀 검사' Do While Cells(iRow, iCol + tC + 1) = sVal
tC = tC + 1
Loop If tC > 0 Then ' 우측 병합대상 있는 경우' Do While Cells(iRow + tR + 1, iCol) = sVal For i = 0 To tC
If Cells(iRow + tR + 1, iCol + i) <> sVal Then Exit Do
Next i
tR = tR + 1
Loop Range(Cells(iRow, iCol), Cells(iRow + tR, iCol + tC)).Merge iCol = iCol + tC iCount = iCount + 1
Else
Do While Cells(iRow + tR + 1, iCol) = sVal
tR = tR + 1
Loop
If tR > 0 Then Range(Cells(iRow, iCol), Cells(iRow + tR, iCol)).Merge iCount = iCount + 1 End If
iCol = iCol + 1
End If
tC = 0: tR = 0
Else
Cells(iRow, iCol).Offset(0, 1).Select
iCol = Selection.Column
End If
If iCol > cMax Then
iCol = cSave: iRow = iRow + 1
End If Loop
Application.DisplayAlerts = True Application.ScreenUpdating = True
MsgBox Trim(iCount) & "개의 병합셀이 만들어졌습니다."
End Sub
|
참고