|
'-----------------------
Sub summary()
'-----------------------
' [코드] 범위
Dim rX As Range: Set rX = Range("D4", [D4].End(xlDown))
' collection 객체 생성
Dim colX As New Collection
Dim c As Range
'---------------------------
On Error Resume Next
'---------------------------
Dim K As Variant, V As Variant, iCnt As Long, itemX As Variant
Dim sKey As String
'-----------------------
For Each c In rX.Cells
'-----------------------
' K_코드, Y_분류
K = CStr(c.Value): V = c.Offset(0, 1).Value
' 수량
iCnt = c.Offset(0, 2).Value
' 수량이 0이면 last_line 라벨로 이동
If iCnt = 0 Then GoTo last_line
' 키에 해당하는 값 구하기
' 키가 없으면 Err발생 즉 err.number>0
itemX = colX.Item(K)
' 에러 나면 즉, 새로운 키일 경우
If Err.Number Then ' 에러나면
' key를 ,를 기준으로 연결
If sKey = "" Then sKey = K Else sKey = sKey & "," & K
' key, value추가
colX.Add V, K
Else ' 에러 안 나면, 즉 기존 키가 있음
V = itemX & V
' 항목 지우기
colX.Remove K
' 다시 추가
colX.Add V, K
End If
' error초기화
Err.Number = 0
' 수량이 0일 경우 지금 label로 이동
last_line:
'-----
Next c
'-----
' Error Handler 초기화
On Error GoTo 0
' 붙여넣을 위치
Dim rT As Range: Set rT = [H4]
' 기존 자료 지우기
rT.CurrentRegion.ClearContents
'--------------------------------
For Each key In Split(sKey, ",")
'--------------------------------
' 서식을 텍스트
rT.NumberFormat = "@"
rT.Value = key
rT.Offset(, 1).Value = colX.Item(key)
' 바로 아래 셀로 이동
Set rT = rT.Offset(1)
Next key
Set colX = Nothing
End Sub
|
|