请教多条学历信息合并到一个单元格

quqiyuan

参与一下，供参考。。。

quqiyuan

代码如下。。。
Sub test()
    Set d = CreateObject("scripting.dictionary")
    arr = Sheet1.[a1].CurrentRegion
    For i = 2 To UBound(arr)
        s = arr(i, 2)
        If Not d.exists(s) Then Set d(s) = CreateObject("scripting.dictionary")
        d(s)(i) = i
    Next
    ReDim brr(1 To d.Count, 1 To 2)
    For Each k In d.keys
        Key = d(k).keys
        For i = 0 To UBound(Key) - 1
            For j = i + 1 To UBound(Key)
                If CDate(arr(Key(i), 3)) > CDate(arr(Key(j), 3)) Then
                    t = Key(i)
                    Key(i) = Key(j)
                    Key(j) = t
                End If
            Next
        Next
        n = n + 1
        For i = 0 To UBound(Key)
            s = Empty
            br = Application.Index(arr, Key(i))
            For j = 3 To UBound(br)
                If s = Empty Then s = br(j) Else s = s & " " & br(j)
            Next
            brr(n, 1) = k
            If brr(n, 2) = Empty Then brr(n, 2) = s Else brr(n, 2) = brr(n, 2) & vbCrLf & s
        Next
    Next
    Sheet1.[a23].Resize(, 2) = [{"姓名","学历详情"}]
    Sheet1.[a24].Resize(n, 2) = brr
    Set d = Nothing
    Beep
End Sub

renkangjizhen

VBA排序+字典即可解决

飞天篮球猪

木图天

飞天篮球猪 发表于 2024-9-7 09:53

谢谢！新函数功能真厉害！ 遗憾的是俺目前电脑不能用groupby()和byrow()

blackttea1

有实用性，谢谢分享

ykcbf1100

参与一下。。。

ykcbf1100

参与一下。。。

sunya_0529

WPS里的JSA练习一下——