|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
- Sub grf()
- Set dlx = CreateObject("scripting.dictionary") '类型对应的课程(二维表)
- arr = Sheet2.[a1].CurrentRegion
- For j = 1 To UBound(arr, 2)
- lx = Right(arr(1, j), 1)
- c = Sheet2.Cells(65536, j).End(3).Row
- dlx(lx) = Sheet2.Cells(2, j).Resize(c - 1)
- Next
-
- Set d1 = CreateObject("scripting.dictionary") '
- Set d2 = CreateObject("scripting.dictionary")
- arr = Sheets(1).[a1].CurrentRegion
- For i = 2 To UBound(arr)
- d1(arr(i, 1) & arr(i, 2) & arr(i, 3)) = arr(i, 4) '类型+考号+课程 对应的分数
- d2(arr(i, 2)) = arr(i, 1) '考号对应的类型
- Next
-
- ReDim brr(1 To UBound(arr), 1 To 2)
- For Each kh In d2.keys '考号
- lx = d2(kh) '考号对应的类型
- For k = 1 To UBound(dlx(lx))
- kc = dlx(lx)(k, 1) '类型对应的课程
- If d1(lx & kh & kc) < 60 Then '类型+考号+课程对应的分数
- n = n + 1
- brr(n, 1) = kh
- brr(n, 2) = kc
- End If
- Next
- Next
-
- With Worksheets("sheet3")
- .[a2:b10000].ClearContents
- .Columns(1).NumberFormatLocal = "@"
- .Range("a2").Resize(n, 2) = brr
- End With
- End Sub
复制代码 |
评分
-
1
查看全部评分
-
|