직장에서 4대보험 업무를 맡아보고 있는데 불편한점이 엑셀로 파일을 저장하면 화면보이는 그대로 셀병합을 시켜서 출력하는 바람에 추출하는데 힘들었다..
그렇다고 매번 수작업으로 하자니 할때마다 방식이 오락가락하여 방법이 틀려질거 같아 매크로를 활용해보자고 아침부터 일어나 부지런히 매크로 기록을 하고 분석하고 했건만 역시나 코드를 줄이기에는 내 실력이 바닥인게 문제였다.
그래서 열심히 구글검색을 하다가 한줄기 단비같은 블로그에서 답을 찾을 수 있었다.
두세곳에서 방법을 찾았는데 한곳은 전체 셀을 대상으로 계산하다보니 반응이 많이 느렸고 아래 소개하는 방법은 선택된 셀만 셀병합 해제후 자동으로 채워주기 때문에 반응이 LTE급이다! 이제 업무에 적용시키는 일만 남았다
대략적인 상황 설명: 엑셀로 내려받은 파일이 병합되어 2가지 조건을 걸어서 합계를 찾으려고 했다. 하지만 SUMIFS 함수가 배열을 활용하다보니 셀이 하나라도 비어있으면 찾기를 못한다. 아래 블로그 글은 셀을 분리한뒤 자동으로 채워주는 기능까지 단 27줄에 끝내준다.
임시로 적용시켜 보았는데 우선 불필요한 상단 셀을 날려버리고 내용이 있는 곳에서 분리할 셀을 선택까지 해주고 셀 분리&자동 채우기 까지 담당하는 매크로를 이어주면 계산할 준비끝. 이제 다음 시트에 미리 입력해둔 명단을 가지고 긁어오면 된다.
막힐때 한방에 뚫어주는걸 보면 프로그래머라는 직업이 참 존경스럽다
==========
Option Explicit
Sub unMerge_and_Fill()
Dim rngC As Range '선택영역 각 셀을 넣을 변수
Dim r As Long '카운터로 사용할 변수
Application.ScreenUpdating = False '화면 업데이트 중지
With Selection
If .Cells.Count = 1 Then '한 셀만 선택 시 매크로 중지
MsgBox "한 셀만 선택함. 영역 재설정 후 실행", 64, "영역설정 오류"
Exit Sub '매크로 중단
End If
End With
For Each rngC In Selection '선택 영역을 순환
If rngC.MergeCells Then '만일 선택셀이 셀병합 되어 있다면
With rngC.MergeArea '셀병합된 area를
.UnMerge '셀병합을 풀고
.Value = rngC '셀병합 풀린영역 셀병합전 값으로 채움
End With
r = r + 1 '카운터를 1씩 늘려감
End If
Next
If r > 0 Then
MsgBox "전체 " & r & "개의 셀병합된 셀을 풀고 복사했음"
Else
MsgBox "선택 영역내에 병합된 셀이 없음.", vbInformation, "병합된셀 없음"
Exit Sub
End If
End Sub
'2011-7-20 수정 : 한 셀만 선택시 재실행 메시지창 추가
'2011-12-22 수정 : 가로 셀병합에 작동 안하던 것 수정.
=====================================
▷ 네이버 니꾸님(rosa0189) 블로그 - (87) 셀병합 해제하고 같은 값으로 채우기 (엑셀 VBA 매크로)
그렇다고 매번 수작업으로 하자니 할때마다 방식이 오락가락하여 방법이 틀려질거 같아 매크로를 활용해보자고 아침부터 일어나 부지런히 매크로 기록을 하고 분석하고 했건만 역시나 코드를 줄이기에는 내 실력이 바닥인게 문제였다.
그래서 열심히 구글검색을 하다가 한줄기 단비같은 블로그에서 답을 찾을 수 있었다.
두세곳에서 방법을 찾았는데 한곳은 전체 셀을 대상으로 계산하다보니 반응이 많이 느렸고 아래 소개하는 방법은 선택된 셀만 셀병합 해제후 자동으로 채워주기 때문에 반응이 LTE급이다! 이제 업무에 적용시키는 일만 남았다
대략적인 상황 설명: 엑셀로 내려받은 파일이 병합되어 2가지 조건을 걸어서 합계를 찾으려고 했다. 하지만 SUMIFS 함수가 배열을 활용하다보니 셀이 하나라도 비어있으면 찾기를 못한다. 아래 블로그 글은 셀을 분리한뒤 자동으로 채워주는 기능까지 단 27줄에 끝내준다.
임시로 적용시켜 보았는데 우선 불필요한 상단 셀을 날려버리고 내용이 있는 곳에서 분리할 셀을 선택까지 해주고 셀 분리&자동 채우기 까지 담당하는 매크로를 이어주면 계산할 준비끝. 이제 다음 시트에 미리 입력해둔 명단을 가지고 긁어오면 된다.
막힐때 한방에 뚫어주는걸 보면 프로그래머라는 직업이 참 존경스럽다
==========
Option Explicit
Sub unMerge_and_Fill()
Dim rngC As Range '선택영역 각 셀을 넣을 변수
Dim r As Long '카운터로 사용할 변수
Application.ScreenUpdating = False '화면 업데이트 중지
With Selection
If .Cells.Count = 1 Then '한 셀만 선택 시 매크로 중지
MsgBox "한 셀만 선택함. 영역 재설정 후 실행", 64, "영역설정 오류"
Exit Sub '매크로 중단
End If
End With
For Each rngC In Selection '선택 영역을 순환
If rngC.MergeCells Then '만일 선택셀이 셀병합 되어 있다면
With rngC.MergeArea '셀병합된 area를
.UnMerge '셀병합을 풀고
.Value = rngC '셀병합 풀린영역 셀병합전 값으로 채움
End With
r = r + 1 '카운터를 1씩 늘려감
End If
Next
If r > 0 Then
MsgBox "전체 " & r & "개의 셀병합된 셀을 풀고 복사했음"
Else
MsgBox "선택 영역내에 병합된 셀이 없음.", vbInformation, "병합된셀 없음"
Exit Sub
End If
End Sub
'2011-7-20 수정 : 한 셀만 선택시 재실행 메시지창 추가
'2011-12-22 수정 : 가로 셀병합에 작동 안하던 것 수정.
=====================================
▷ 네이버 니꾸님(rosa0189) 블로그 - (87) 셀병합 해제하고 같은 값으로 채우기 (엑셀 VBA 매크로)
▷ 병합된 셀을 분리하고 자동으로 채워준다.
댓글 없음:
댓글 쓰기