- Sub k()
- Dim arr As Variant
- Dim i As Integer, k As Integer
- Dim jg(1 To 10000, 1 To 8)
- Dim d As Object
- Set d = CreateObject("scripting.dictionary")
- arr = Sheet2.[a1].CurrentRegion.Value
- For i = 2 To UBound(arr)
- If Not d.exists(arr(i, 1)) Then
- k = k + 1
- d(arr(i, 1)) = k
- jg(k, 2) = arr(i, 3)
- jg(k, 3) = arr(i, 1)
- jg(k, 4) = arr(i, 2)
- jg(k, 7) = jg(k, 4)
- jg(k, 5) = 0
- End If
- Next
- arr = Sheet4.[a1].CurrentRegion.Value
- For i = 2 To UBound(arr)
- If d.exists(arr(i, 2)) Then
- k = d(arr(i, 2))
- jg(k, 1) = arr(i, 1)
- jg(k, 5) = jg(k, 5) + 1
- jg(k, 6) = jg(k, 6) & arr(i, 3) & ","
- jg(k, 7) = jg(k, 4) - jg(k, 5)
- End If
- Next
- [a1].CurrentRegion.Offset(1).ClearContents
- [a2].Resize(k, 8).Value = jg
- End Sub
复制代码 |