|
* 답변하시는 분들께 도움이 되도록 자신의 환경을 아래 항목 옆에 기재해 주세요.
- 엑셀 버전(95,97,2000,xp,2003,2007):
* 아래줄에 질문을 작성하세요 >>
현재 시트의 Q열부터 Z열까지 적용된 배열함수를 이용해보려 했으나 너무 느려서 질문드립니다.
VBA를 이용해서 좀 더 빠르게 해결이 가능할까요?
편의를 위해 DB를 조금 남겨 놨는데 사실 이만건이 넘기때문에 범위 수정을 할수 있는 방법을 알려주시면 감사하겠습니다.
혹시 가능하다면 가능할까 시트에 표시하고 싶습니다..!
제발 부탁드립니다!
==============[띠요오옹님 글에 대한 답변입니다]==============
첨부화일 참조하세요...
Sub getCode()
Dim sht As Worksheet
Dim rData As Range, rX As Range
Dim rMainCode As Range
Dim rFind As Range, sAddr As String
Dim iX As Integer
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
Set rMainCode = Worksheets("현재").Columns(2)
Set sht = ActiveSheet
Set rData = sht.Range(sht.Cells(3, 1), sht.Cells(Rows.Count, 1).End(xlUp))
rData.CurrentRegion.Offset(, 1).ClearContents
For Each rX In rData
Set rFind = rMainCode.Find(rX.Value, , , xlWhole)
If Not rFind Is Nothing Then
sAddr = rFind.Address
iX = 1
Do
rX.Offset(, iX) = rFind.Offset(, 1).Value
Set rFind = rMainCode.FindNext(rFind)
iX = iX + 1
Loop While Not rFind Is Nothing And rFind.Address <> sAddr
End If
Next
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
End Sub
|
|