如何根据原始表各学科名单生成目标表即名单中所属各学科

yzyyyyyyy

原始表：各学科名单

目标表：各名单所属学科
直接从原始表生成目标表 如何根据原始表各学科名单生成目标表即名单中所属各学科.rar (2 KB, 下载次数: 2)

2023-2-9 16:39 上传

点击文件名下载附件

3190496160

Sub 统计()
Application.ScreenUpdating = False
Dim ar As Variant
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("原始表")
    ar = .UsedRange
End With
Dim br()
ReDim br(1 To 10000, 1 To 50)
For i = 2 To UBound(ar)
    For j = 1 To UBound(ar, 2)
        If Trim(ar(i, j)) <> "" Then
            If Not d.exists(Trim(ar(i, j))) Then
                 d(Trim(ar(i, j))) = ar(1, j)
            Else
                 d(Trim(ar(i, j))) = d(Trim(ar(i, j))) & "|" & ar(1, j)
            End If
        End If
    Next j
Next i
For Each k In d.keys
    n = n + 1
    br(n, 1) = k
    If InStr(d(k), "|") = 0 Then
        br(n, 3) = d(k)
        br(n, 2) = 1
    Else
        rr = Split(d(k), "|")
        y = 2
        br(n, 2) = UBound(rr) + 1
        For s = 0 To UBound(rr)
            y = y + 1
            br(n, y) = rr(s)
        Next s
    End If
Next k
With Sheets("目标表")
    .UsedRange = Empty
    .[a3].Resize(n, UBound(br, 2)) = br
End With
End Sub

3190496160