用excel汇总教师任课表

万能的vba可以完成。举例说明：

例如有表格如图：

第一步：编制代码如下：

Sub 任课老师汇总()

Dim 学科 As String

Dim 名称 As String

Dim 班级 As String

Dim bjZD

Set bjZD = CreateObject("SCRIPTING.DICTIONARY")

Dim JGARR(1 To 100, 1 To 3)

hh = 2: zz = 0

Do While Cells(hh, 1) <> ""

学科 = Cells(hh, 1).Text

LH = 2

Do While Cells(hh, LH) <> ""

班级 = Cells(1, LH).Text

名称 = Cells(hh, LH).Text

If Not bjZD.EXISTS(名称) Then

zz = zz + 1

bjZD.Add 名称, 班级

JGARR(zz, 2) = 名称

JGARR(zz, 1) = 学科

Else

bjZD(名称) = bjZD(名称) & "," & 班级

End If

LH = LH + 1

Loop

hh = hh + 1

Loop

For i = 1 To zz

JGARR(i, 3) = bjZD(JGARR(i, 2))

Next i

'输出结果

Cells(7, 1).Resize(zz, 3) = JGARR

End Sub

运行后结果如图：

用代码解决吧，仅供参考

Sub tonghangnihao()
Dim d, ar, br(1 To 888, 1 To 3), r%, c%, k%, y%
Set d = CreateObject("scripting.dictionary")
ar = [a1].CurrentRegion
For r = 2 To UBound(ar)
    For c = 2 To UBound(ar, 2)
        st = ar(r, 1) & ar(r, c)
        If Not d.exists(st) Then
            k = k + 1
            d(st) = k
            br(k, 1) = ar(r, 1)
            br(k, 2) = ar(r, c)
            br(k, 3) = ar(1, c)
        Else
            y = d(st)
            br(y, 3) = br(y, 3) & "," & ar(1, c)
        End If
    Next
Next
With [p1]
    .Resize(1, 3) = Array("学科", "名称", "任课班级")
    .Offset(1).Resize(k, 3) = br
End With
End Sub

能不能把教师任课表做成另外一个表？把班级变成列，课程变成行。