|
- Public km$
- Sub cjdz()
- Dim i&, Myr&, Arr, Arrjg, Arrdz, j&, sk%, zf, jgr%, yr%, n&, col1%
- Dim d, k, t, r1, x, col%, ks&, js&, jgf, yf, zgf, zdf, Myr6&, r2
- Set d = CreateObject("Scripting.Dictionary")
- Myr = Sheet1.[e65536].End(xlUp).Row
- Arr = Sheet1.Range("e5:p" & Myr)
- Arrjg = Sheet4.[e7:l10]
- For i = 1 To UBound(Arrjg, 2)
- If Arrjg(1, i) = km Then
- jgf = Arrjg(3, i)
- yf = Arrjg(4, i)
- Exit For
- End If
- Next
- Set r1 = Sheet1.Rows(4).Find(km)
- col = r1.Column - 4
- For i = 1 To UBound(Arr)
- x = Arr(i, 1) & "|" & Arr(i, 3)
- d(x) = d(x) + 1
- Next i
- k = d.keys
- t = d.items: zdf = 120
- ReDim Arrdz(1 To UBound(k) + 1, 1 To 13)
- For i = 0 To UBound(k)
- Arrdz(i + 1, 1) = Split(k(i), "|")(0) '学校
- Arrdz(i + 1, 2) = Split(k(i), "|")(1) '班级
- Arrdz(i + 1, 3) = t(i) '应考人数
- If i = 0 Then
- ks = 1: js = t(i)
- Else
- ks = t(i - 1) + 1: js = t(i - 1) + t(i)
- End If
- For j = ks To js
- If Arr(j, col) <> "" Then
- sk = sk + 1
- zf = zf + Arr(j, col)
- If Arr(j, col) >= jgf Then jgr = jgr + 1
- If Arr(j, col) >= yf Then yr = yr + 1
- If Arr(j, col) > zgf Then zgf = Arr(j, col)
- If Arr(j, col) < zdf Then zdf = Arr(j, col)
- End If
- Next
- Arrdz(i + 1, 4) = sk '实考人数
- Arrdz(i + 1, 5) = zf '总分
- Arrdz(i + 1, 6) = zf / sk '平均分
- Arrdz(i + 1, 7) = jgr '及格人数
- Arrdz(i + 1, 8) = jgr / sk '及格率
- Arrdz(i + 1, 9) = yr '优分人数
- Arrdz(i + 1, 10) = yr / sk '优分率
- Arrdz(i + 1, 11) = zgf '最高分
- Arrdz(i + 1, 12) = zdf '最低分
- sk = 0: zf = 0: jgr = 0: yr = 0: zgf = 0: zdf = 120
- Myr6 = Sheet6.[c65536].End(xlUp).Row
- Sheet6.[b7].Formula = "=rc[1]&""|""&rc[2]"
- Sheet6.[b7].AutoFill Sheet6.Range("b7:b" & Myr6)
- Sheet6.Range("b7:b" & Myr6) = Sheet6.Range("b7:b" & Myr6).Value
- Set r1 = Sheet6.Columns(2).Find(k(i))
- If Not r1 Is Nothing Then
- n = r1.Row
- Set r2 = Sheet6.Rows(6).Find(km)
- col1 = r2.Column
- Arrdz(i + 1, 13) = Sheet6.Cells(n, col1) '教师
- End If
- Next
- Sheet3.Activate
- [c7:o200].ClearContents
- [c7].Resize(UBound(Arrdz), 13) = Arrdz
- End Sub
复制代码 |
|