这种问题,vba来处理是最佳方案,仅供参考:
Sub test()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
With Sheets("任课表")
x = .Cells(Rows.Count, 1).End(xlUp).Row
y = .Cells(1, Columns.Count).End(xlToLeft).Column
ar = .Range(.Cells(1, 1), .Cells(x, y))
End With
ReDim br(1 To UBound(ar) * UBound(ar, 2), 1 To 3)
For i = 2 To UBound(ar)
For j = 5 To UBound(ar, 2)
If Trim(ar(i, j)) <> "" Then
t = d(Trim(ar(i, j)))
If t = "" Then
k = k + 1
d(Trim(ar(i, j))) = k
t = k
br(k, 1) = ar(i, j)
End If
If br(t, 2) = "" Then
br(t, 2) = ar(1, j)
Else
br(t, 2) = br(t, 2) & "," & ar(1, j)
End If
If br(t, 3) = "" Then
br(t, 3) = ar(i, 1)
Else
br(t, 3) = br(t, 3) & "," & ar(i, 1)
End If
End If
Next j
Next i
For i = 1 To k
m = ""
dc.RemoveAll
rr = Split(br(i, 2), ",")
For s = 0 To UBound(rr)
dc(Trim(rr(s))) = ""
Next s
For Each kk In dc.keys
If m = "" Then
m = kk
Else
m = m & "," & kk
End If
Next kk
br(i, 2) = m
Next i
With Sheets("要求")
.UsedRange.Offset(1) = Empty
.[b2].Resize(k, 3) = br
End With
End Sub
|