求助帅气的大神，如何在多对多中保留不重复的唯一值

zopey

abc123281 发表于 2018-6-6 17:59

'对7楼代码 的补充

Sub test()
Dim d, d2
Set d = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")
arr = Worksheets("sheet1").UsedRange
For i = 2 To UBound(arr)
    If Not d.exists(arr(i, 4)) Then
       If Not d2.exists(arr(i, 6)) Then
          d(arr(i, 4)) = arr(i, 6)
          d2(arr(i, 6)) = ""
       End If
    Else
    End If
Next

Range("a2").Resize(d.Count, 2) = Application.Transpose(d.keys)
Range("b2").Resize(d.Count, 1) = Application.Transpose(d.items)
End Sub


帮助3.zip (162.49 KB, 下载次数: 2)

2018-6-7 09:41 上传

点击文件名下载附件

晚安·

abc123281 发表于 2018-6-6 17:59

感谢大神
没有表述明白我的意思。
就是相当于给每个班安排一个班主任，每个老师都要至少当一次班主任。
要求就是：老师必须在自己任课的班级中，当班主任。

晚安·

zopey 发表于 2018-6-7 09:22
看标题是给每个班 配上班主任!

对的。
就是每个老师都要当班主任，最少一个班，但必须是自己任课的班级