나눔터  
  HOME > 나눔터 > 묻고답하기 > 엑셀
엑셀
엑셀에 대한 질문과 답변을 올려주세요. 단, 취지에 맞지 않는 글은 운영자가 삭제합니다.
 "000 님, 도와주세요", "부탁 드립니다.", "급합니다!" 등과 같이 막연한 제목을 달지 말아주세요.
[필독] 빠르고 정확한 답변을 얻는 16가지 Tip !
[필독] 저작권법 개정에 따른 이용안내
작성자:  

 조삿갓 (choga21)

추천:  2
파일:     MergeCell[2].bas (4KB) 조회:  3112
제목:   [RE]똑똑한 셀병합, 셀 분리 유틸
     
  - 엑셀 버전(95,97,2000,xp,2003,2007):2007

* 아래줄에 질문을 작성하세요 >>
안녕하세요?
아래와 같이 입력되어 있습니다. 
A1 : 가
A2 : 나
A3 : 다

A1,A2,A3을 셀선택후 병합하기 하면 "가"만 표시됩니다. 
셀병합하더라도





위와같이 한번에 줄발꿈되어 B1셀에 한번에 표시되게 할수 있을까요?
함수를 쓰던지 해도 될듯합니다.
==============[박찬우님 글에 대한 답변입니다]==============

제가 필요해서 만들어 쓰고 있는 VB 매크로 모듈을 공개합니다.
셀 병합, 분리와 관련하여 5개의 유용한 매크로 프로시저를 포함하고 있습니다.
각각의 주석을 참고하시기 바랍니다.

사용방법은
1) 첨부 파일을 다운로드 받아서
2) 사용하려는 엑셀 파일을 열고
3) 리본 메뉴에 [개발도구] 탭이 보이는지 확인해 보세요.
4) 만일 안 보이면 [파일]-[옵션] 메뉴 실행하여
   대화 창에서 왼쪽 중간 쯤에 [리본 사용자 지정] 탭 클릭
   오른쪽 트리 목록에서 '개발도구' 찾아서 체크 선택
   [확인] 단추 눌러서 옵션 창 닫기
5) 개발도구 탭에서 맨 왼쪽 Visual Basic 아이콘을 누르면 편집기가 열림
6) VB 편집기 메뉴에서 [파일]-[가져오기] 메뉴 실행
7) 다운로드 받은 Merge.bas 파일 선택하여 열기
8) 매크로 포함한 파일 형식(*.xlsm)으로 다른 이름 저장

이와 같이 하고 나서
1) 워크시트에서 병합하고자 하는 셀을 범위로 선택하고
2) [개발도구]-[매크로] 또는 [보기]-[매크로 보기] 메뉴 실행하면
   아래 매크로들의 이름이 나열됩니다.
3) 원하는 매크로를 선택하여 [실행] 버튼 누르면 됨

이 매크로 보기 창에서는 각 매크로에 단축키를 설정할 수도 있습니다.
참고: ● http://www.officetutor.co.kr/board/Dtype/bfrmvw.asp?f_tn=Dqa_excel_n2&f_bno=123863&page=1&fchk=&fval=

===== 매크로 프로시저 내용 =====
' 줄바꿈을 기준으로 셀 나누기 또는 셀 병합
' (c) 조삿갓(choga21), 2017. 8. 27. 개정
' 임의 배포 가능한 Open Source임. 단, 저작권 도용 및 상업적 이용 금지

Sub MergeCell()
' 선택한 셀을 데이터 손실 없이 병합
' 옆에 있는 셀은 코머로, 위아래 셀은 줄바꿈으로 바꾸어 줌
    Dim r As Long
    Dim c As Integer
    Dim sr As Long
    Dim sc As Integer
    Dim con As Variant
    
    With Selection
        sr = .Rows.Count
        sc = .Columns.Count
        r = 1
        con = .Cells(r, 1)
        Do
            For c = 2 To sc
                con = con & ", " & .Cells(r, c)
                .Cells(r, c).ClearContents
            Next c
            If r >= sr Then Exit Do
            r = r + 1
            con = con & vbLf & .Cells(r, 1)
            .Cells(r, 1).ClearContents
        Loop
        .Cells(1) = con
        .Merge
    End With
End Sub

Sub MergeNPack()
' 위 MergeCell을 실행 후,
' 병합하여 데이터를 옮긴 셀은 그 행/열 전체를 삭제함
' 단, 다른 열에 데이터가 있을 경우에는 삭제하지 않음
    Dim r As Long
    Dim c As Integer
    Dim sr As Long
    Dim sc As Integer
    Dim con As Variant
    Dim rng As Range
    
    Call MergeCell
    With Selection
        sr = .Rows.Count
        For r = sr To 2 Step -1
            Set rng = .Cells(r, 1).EntireRow
            If WorksheetFunction.CountA(rng) = 0 Then rng.Delete
        Next r
        sr = .Rows.Count
        For c = sc To 2 Step -1
            Set rng = .Cells(1, c).EntireColumn
            If WorksheetFunction.CountA(rng) = 0 Then rng.Delete
        Next c
    End With
End Sub


Sub 땡땡()
' 선택한 영역의 셀들을 검사하여 빈 셀이면
' 바로 위 셀의 내용을 복사함
    Dim c As Range
    For Each c In Selection
        If c = Empty Then
            c = c.Cells(0, 1)
        End If
    Next c
End Sub

Sub RowSplit_Cells()
' 줄바꿈을 기준으로 셀 내용을 분리함
' 만일 바로 아래 셀에 이미 내용이 있는 경우에는 행을 추가함
    Dim r As Long
    Dim c As Integer
    Dim rs As Long
    Dim r1 As Long
    Dim r2 As Long
    Dim cs As Integer
    Dim ce As Integer
    Dim v As Variant
    Dim e As Variant
    
    With Selection
        rs = .Row
        r = .Rows.Count + rs - 1
        cs = .Column
        ce = .Columns.Count + cs - 1
        .UnMerge
    End With
    Do
        r1 = r
        r2 = r
        For c = cs To ce
            r = r1
            v = Split(Cells(r, c), vbLf)
            Cells(r, c).ClearContents
            For Each e In v
                If Cells(r, c) <> Empty Then
                    Cells(r, c).EntireRow.Insert
                    r2 = r
                End If
                Cells(r, c) = e
                r = r + 1
            Next e
        Next c
        r = r1 - 1
    Loop Until r < rs
End Sub

Sub ColumnSplit_Cells()
' 코머를 기준으로 셀 내용을 오른쪽으로 분리함
' 만일 바로 오른쪽 셀에 이미 내용이 있는 경우에는 열을 추가함
' 단, 셀 내용 중에 줄바꿈이 포함된 경우에는 아무 일도 안함
' (RowSplit을 먼저 실행할 것)
    Dim r As Long
    Dim c As Integer
    Dim rs As Long
    Dim re As Long
    Dim c1 As Long
    Dim c2 As Long
    Dim cs As Integer
    Dim v As Variant
    Dim e As Variant
    
    With Selection
        rs = .Row
        re = .Rows.Count + rs - 1
        cs = .Column
        c = .Columns.Count + cs - 1
        .UnMerge
    End With
    Do
        c1 = c
        c2 = c
        For r = rs To re
            c = c1
            If InStr(Cells(r, c), vbLf) > 0 Then Exit For
            v = Split(Cells(r, c), ",")
            Cells(r, c).ClearContents
            For Each e In v
                If Cells(r, c) <> Empty Then
                    Cells(r, c).EntireColumn.Insert
                    c2 = c
                End If
                Cells(r, c) = e
                c = c + 1
            Next e
        Next r
        c = c1 - 1
    Loop Until c < cs
End Sub
 
[불량 게시물 신고]  
        
  

작성일 : 2018-03-15(18:40)
최종수정일 : 2018-03-15(18:40)
 


 ◎ 관련글

  제 목   작성자   날짜
셀병합 박찬우 2018-03-15
[RE]똑똑한 셀병합, 셀 분리 유틸 조삿갓 2018-03-15