엑셀 VBA에서 가장 범하기 쉬운 오류가 Range 범위를 잡는 방법이다.
Range 를 많이 잡으면 메모리 공간을 많이 차지하므로 작업속도가 엄청나게 느려질 수 있다.
그래서 자료가 5만개, 10만개 30만개 60만개, 100만개나 되는 데이터 작업을 할 때에는 반드시 Range 범위를 분할해주어야 한다.
약 10만개의 전화번호 데이터를 작업하는데 내 PC 기준으로 100초 걸렸다.
코드를 최적화하는 방법을 고민하느라고 시간을 많이 할애하였다.
계속 고민하다보면 더 나은 방법은 계속 찾아지는 거 같다
이 코드는 아래 빨간색으로 된 부분만 수정해서 사용하면 됩니다.
컴퓨터 성능에 따라서 SplitLine 을 적정하게 변경하면 되구요. 시작할 행과 전화번호가 들어있는 열만 변경해주면 끝~~!!!!
만약 정리하고 싶은 전화번호가 전부 휴대폰번호라고 한다면 수정할 부분은
Case 8 '//
rngC.Offset(0, 1) = "010-" & Format(strU, "0000-0000")
라고 수정해주면 됩니다.
첨부파일은 텍스트파일이므로 열어서
엑셀에서 Alt + F11 키를 누르고 내용을 붙여넣기를 하면 됩니다.
Option Explicit
Sub 부하없는전화번호정리()
Dim strU As String '// 문자를 합쳐갈 변수
Dim rngC, rngDB As Range '// 각 Line 변수
Dim i, n, r As Double, rcnt%
Dim SplitLine, sRow, eRow As Double
Dim Col As String
Dim T As Single
Application.ScreenUpdating = False '// 화면 업데이트 (일시) 중지
T = Timer() '// 시간 변수 설정
sRow = 2 '// 시작할 행
Col = "E" '// 전화번호가 들어있는 열 지정
SplitLine = 3000 '// 전체행을 모두 범위설정하면 메모리 부족현상으로 속도저하 발생
rcnt = ((Cells(Rows.Count, Col).End(3).Row - sRow) \ SplitLine) + 1
For n = 1 To rcnt
If (SplitLine + sRow) > Cells(Rows.Count, Col).End(3).Row Then
eRow = Cells(Rows.Count, Col).End(3).Row '// 마지막 행이 SplitLine 보다 작으면
Else
eRow = SplitLine + sRow '// 마지막 행이 SplitLine 보다 크면
End If
Set rngDB = Range(Cells(sRow, Col), Cells(eRow, Col))
For Each rngC In rngDB
r = rngC.Row
For i = 1 To Len(rngC) '// 전체 문자길이 만큼 반복
If IsNumeric(Mid(rngC, i, 1)) Then '// 문자열이 숫자일 경우
strU = strU & Mid(rngC, i, 1) '// 각 숫자를 합쳐감
End If
Next i
Select Case Len(strU) '// IF 문에서 숫자만 추출된 strU 의 길이 검사
Case 8 '// 전국대표번호 처럼 8자리로 된 경우
rngC.Offset(0, 1) = Format(strU, "0000-0000")
Case 9
rngC.Offset(0, 1) = Format(strU, "00-000-0000")
Case 10
If Left(strU, 2) = "02" Then
rngC.Offset(0, 1) = Format(strU, "00-0000-0000")
Else
rngC.Offset(0, 1) = Format(strU, "000-000-0000")
End If
Case 11
rngC.Offset(0, 1) = Format(strU, "000-0000-0000")
End Select
strU = "" '// 값을 기록했으니까 초기화가 필요함
Next rngC
Set rngDB = Nothing '// 메모리 비우기 (초기화)
sRow = r + 1 '// 시작행으로 지정
Next n
MsgBox "완료!! " & vbLf & vbLf & Format(Timer() - T, "0.00초 걸림"), 64, Now()
End Sub
'업무 능력 향상 > 엑셀 VBA 활용' 카테고리의 다른 글
[VBA] 통합자막 정리 실패 1탄 (0) | 2015.06.05 |
---|---|
[VBA] 현재 엑셀 시트 CSV로 내보내기 (0) | 2015.06.03 |
[VBA] 주소 분리 변환 (0) | 2015.06.01 |
[VBA] 2개의 조건(다중조건)이 일치하는 데이타 찾기 (0) | 2015.05.31 |
[VBA] 전화번호 - 들어간 거 제거하기 (0) | 2015.05.29 |