excel特殊数据处理

这是sheet1的

现在我要处理成sheet2，有一些项目是几个人一起做的，用“/”间隔开的怎样才可以求除表2？？？紧急

VBA代码如下：
Sub test()
Dim d1 As Object, d2 As Object, mAryA, mAryB(1 To 65535, 1 To 3), mAryC
Dim k As Long, i As Long, j As Long
Set d1 = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")
mAryA = [a1].CurrentRegion
k = 0
For i = 2 To UBound(mAryA, 1)
    mAryC = Split(mAryA(i, 1), "/")
    For j = LBound(mAryC) To UBound(mAryC)
        k = k + 1
        mAryB(k, 1) = mAryC(j)
        mAryB(k, 2) = mAryA(i, 2)
        mAryB(k, 3) = mAryA(i, 3)
    Next j
Next i
For i = 1 To k
    d1(mAryB(i, 1)) = d1(mAryB(i, 1)) + mAryB(i, 2)
    d2(mAryB(i, 1)) = d2(mAryB(i, 1)) + mAryB(i, 3)
Next i
With Worksheets("Sheet2")
    .UsedRange.ClearContents
    .[a1].Resize(1, 3) = mAryA
    .[a2].Resize(d1.Count, 3) = Application.Transpose(Array(d1.keys, d1.items, d2.items))
End With
End Sub

将标准按下图输入,数据如图:

将公式

=if(d2="","",vlookup(d2,if({0,1},a2:a6,b2:b6),2,1))

复制后粘贴到"e2"单元格,如图:

改一个数据后如图: