이 게시판은 아별닷컴 회원만 질문을 올릴 수 있습니다. 회원에게 주어지는 특권인셈이지요. 회원이 아닌 분들은 열람만 가능합니다.
글 수 113
![[레벨:4]](http://www.abyul.com/zbxe/modules/point/icons/default/4.gif "포인트:1613point (21%), 레벨:4/30"){kind=icon}
고수가되고파먼저 질문이 많아서 죄송합니다.
운전면허를 따면 운전하고 싶어서 안절부절 하잔아요. 어떻게 하면 잘할까 하기도 하구요.
vba를 시작한지 얼마 안되서요. 궁금한 것이 참으로 많네요.
잘 하구 싶은데 잘 안되서 답답하기도 하구요....
첨부된 예제의
1) "실행전" 워크시트에서 A5:A58 ctrl B5:B58 ctrl D5:D58 을 범위 설정하고 "실행"버튼을 누르면
"실행후" 워크시트 처럼 셀이 병합되고,
2) "실행전" 워크시트에서 A5:B58 ctrl D5:D58 을 범위 설정하고 "실행2"버튼을 누르면
"실행후" 워크시트 처럼 셀이 병합되는데요.------> 1)에 비해서 ctrl을 누르는 횟수가 줄어들죠.
만약 "실행전" 워크시트에서 범위선택하지 않고 "실행"버튼을 눌러서 "실행후" 워크시트 처럼 셀이 병합되게끔 하려고 합니다,
즉, "*공*종*", "규*격", "단*위" 라는 단어를 찾아서 실행이 되게끔 하는거죠.
여기서, "실행전" 워크시트의 3:4행이 1:2행에 위치할 수도 있고, 5:6행 또는 6:7행에 위치 하는 등 특정할 수가 없습니다.
Find메서드를 이용하면 될껏 같은데....
Sub 위셀아래셀병합()
Dim rngRef As Range
Set rngRef = ActiveSheet.UsedRange.Find(what:="*공*종*", "규*격", "단*위")
If rngRef Is Nothing Then
strF = "'*공*종*', '규*격', '단*위'가 입력된 열을 찾지 못했습니다." & vbCr & _
"작업을 종료합니다."
MsgBox strF, vbExclamation, "검색오류"
Exit Sub 여기서부터 막히네요...
If rngRef Is Nothing Then
strF = "'*공*종*', '규*격', '단*위'가 입력된 열을 찾지 못했습니다." & vbCr & _
"작업을 종료합니다."
MsgBox strF, vbExclamation, "검색오류"
Exit Sub 여기서부터 막히네요...
![[레벨:30]](http://www.abyul.com/zbxe/modules/point/icons/default/30.gif "포인트:141861point, 레벨:30/30"){kind=icon}
아별
고수가되고파님..
질문이 좀 많네요.. 하하.. ^-^;;;
아래 코드를 활용해보세요..
첫번째 출현하는 2개 셀을 병합한 다음에.. 병합된 셀을 복사하고..
나머지 셀에 서식으로 붙여넣기를 하여 셀 병합 효과를 나타나게 한 로직입니다.
셀들을 순환하면서 하나씩 병합하는 것보다 속도가 빠를겁니다.
Sub abFindAndMergeCells()
Dim rng As Range
Set rng = Cells.Find(What:="공 종 명", After:=Cells(1, 1), LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
Set rng = Range(rng.Offset(1), rng.Offset(1).End(xlDown))
Dim rngWork As Range
Set rngWork = rng.Resize(2, 1)
rngWork.Cells(2).ClearContents
rngWork.MergeCells = True
rngWork.Copy
rng.Resize(rng.Rows.Count - 2).Offset(2).PasteSpecial Paste:=xlPasteFormats
Union(rng.Offset(0, 1), rng.Offset(0, 3)).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
End Sub