求各位大神帮忙弄个统计函数

nbwzg

学校的课时统计，对我来说非常麻烦，求求各位大神帮忙弄个统计函数，方便统计。万分感谢

yang133319

辅助了一下，免得公式太长，看是不是你要的

nbwzg

yang133319 发表于 2018-3-11 20:27
辅助了一下，免得公式太长，看是不是你要的

实在是太感谢了，这个这个这个正是我需要的

吧123456789

Function zh(a, b)
Dim br(1 To 10000)
    ar = a
    x = UBound(ar)
    y = UBound(ar, 2)
    For m = 2 To x
    For n = 1 To y
        If ar(m, n) <> "" Then
             k = k + 1
          br(k) = ar(1, n) & ar(m, n)
        End If
    Next
    Next
    zh = br(b)
End Function
这个用在统计表
Sub ss()
    Set d1 = CreateObject("Scripting.Dictionary")
    Set d2 = CreateObject("Scripting.Dictionary")
ar = Range("a2:n20")
    x = UBound(ar)
    y = UBound(ar, 2)
    For m = 2 To x
    For n = 2 To y
        d1(ar(m, 1) & ar(1, n)) = ar(m, n)
    Next
    Next
    w = d1.keys
    q = d1.items
    Range("o1").Resize(d1.Count) = Application.WorksheetFunction.Transpose(w)
    Range("p1").Resize(d1.Count) = Application.WorksheetFunction.Transpose(q)
End Sub

这个用在任课表
文件不知到为什么不能上传
另外 我没计算早读等  表格设计不太适合批量全部一次性统计