| |
Option Explicit
'---------------------------------------------
Sub rearrange()
'---------------------------------------------
Dim colX As Collection
Dim oDic As Scripting.Dictionary: Set oDic = New Scripting.Dictionary
Dim rngX As Range: Set rngX = Range("A2").CurrentRegion
Dim vData As Variant: vData = rngX.Offset(1).Resize(rngX.Rows.Count - 1).Value
Dim sKey As String, r As Long
Dim vMoney As String, vSubject As String
'Stop
'----------------------------
For r = 1 To UBound(vData, 1)
'----------------------------
sKey = Join(Array(vData(r, 2), vData(r, 3), vData(r, 4), vData(r, 5)), "-")
'----------------------------
If oDic.Exists(sKey) Then 'exist key
'----------------------------
'Stop
Set colX = oDic.Item(sKey)
' Add Money
' colX.Item("Money") = colX.Item("Money") & "+" & vData(r, 6)
vMoney = colX.Item("Money") & "+" & vData(r, 6)
colX.Remove "Money"
colX.Add vMoney, "Money"
'Add Subject
vSubject = colX.Item("Subject") & "/" & vData(r, 8)
colX.Remove "Subject"
colX.Add vSubject, "Subject"
'-----------------------------
Else
'-----------------------------
Set colX = New Collection
colX.Add vData(r, 6), key:="Money"
colX.Add vData(r, 8), key:="Subject"
oDic.Add sKey, colX
'Stop
End If
Next r
'Stop
Dim key As Variant
Dim rTarget As Range: Set rTarget = Range("A20")
Dim iR As Long: iR = 1
'-------------------------------------
For Each key In oDic.Keys
'-------------------------------------
Debug.Print key
vMoney = oDic.Item(key).Item("Money")
vSubject = oDic.Item(key).Item("Subject")
rTarget.Offset(0, 1).Resize(1, 4).Value = Split(key, "-")
rTarget.Offset(0, 5).Value = Evaluate(vMoney)
rTarget.Offset(0, 7).Value = vSubject
rTarget.Value = iR
iR = iR + UBound(Split(vSubject, "/")) + 1
Set rTarget = rTarget.Offset(1, 0)
'-------------------------------------
Next
'-------------------------------------
End Sub |
|
엑셀에 대한 질문과
답변을 올려주세요. 단, 취지에 맞지 않는 글은 운영자가 삭제합니다.
