|
本帖最后由 szgzxgcx 于 2023-12-23 16:37 编辑
请见附件,感谢!
- Sub kk()
- Dim oldarr(), a As Single, d
- oldarr = Range("a2").CurrentRegion
- a = UBound(oldarr)
- Set d = CreateObject("scripting.dictionary")
- For I = 2 To a
- If Not d.exists(oldarr(I, 3)) Then
- d(oldarr(I, 3)) = oldarr(I, 3)
- d(oldarr(I, 3)) = oldarr(I, 2) & "*" & oldarr(I, 1) & "*" & oldarr(I, 4) & "*" & oldarr(I, 5)
- Else
- d(oldarr(I, 3)) = d(oldarr(I, 3)) & ";" & oldarr(I, 2) & "*" & oldarr(I, 1) & "*" & oldarr(I, 4) & "*" & oldarr(I, 5)
- End If
- Next
- Range("g2").Resize(d.Count, 1) = Application.Transpose(d.keys)
- Range("h2").Resize(d.Count, 1) = Application.Transpose(d.items)
- End Sub
复制代码
见附件
|
|