|
- 엑셀 버전(95,97,2000,xp,2003,2007):2019
------------------
상품 목적지
A 서울
A 대전
A 부산
B 창원
B 포항
B 울진
------------------
형식의 데이터를
------------------
상품 FROM TO
A 서울 부산
A 대전 부산
A 대구 부산
B 창원 울진
B 포항 울진
------------------
형식으로 바꿀 수 있을까요? 각 상품별 최종목적지로 입력되면 됩니다.
==============[샘님 글에 대한 답변입니다]==============
첨부화일 참고하세요...
Sub UserTransForm()
Dim sht As Worksheet
Dim rTable As Range, rX As Range
Dim oDic As Object
Dim vKey, vValue, vResult()
Dim iX As Integer, iSeq As Integer
Dim rTg As Range
Set sht = ActiveSheet
Set rTable = sht.Range("B2").CurrentRegion
Set rTable = rTable.Offset(1).Resize(rTable.Rows.Count - 1)
Set rTg = sht.Range("F3")
rTg.CurrentRegion.Offset(1).ClearContents ' 기존자료 삭제
Application.Wait Now() + TimeValue("00:00:01") ' 1초 대기
Set oDic = CreateObject("Scripting.Dictionary")
For Each rX In rTable.Rows
vKey = rX.Cells(1, 1).Value
vValue = rX.Cells(1, 2).Value
If oDic.Exists(vKey) Then
oDic(vKey) = oDic(vKey) & "," & vValue
Else
oDic.Add vKey, vValue
End If
Next
For Each vKey In oDic.keys
vValue = Split(oDic(vKey), ",")
For iX = LBound(vValue) To UBound(vValue) - 1
iSeq = iSeq + 1
ReDim Preserve vResult(1 To 3, 1 To iSeq)
vResult(1, iSeq) = vKey
vResult(2, iSeq) = vValue(iX)
vResult(3, iSeq) = vValue(UBound(vValue))
Next
Next
vResult = WorksheetFunction.Transpose(vResult) ' 2차원배열로 변환
rTg.Resize(UBound(vResult, 1), UBound(vResult, 2)) = vResult
End Sub
|
|