「代码」「数组法」提取各科成绩第一名的记录，Application.Index函数提取数组整行整列
文摘
教育
2024-10-23 22:50
江苏
1、在工作表“成绩”里，命令按钮点击事件，调用相应过程：Private Sub CmdFirst_Click() Call getFirstEnd Sub
2、在myModule里，getFirst过程，提取各科第一名成绩的记录：Sub getFirst() Dim rng As Range Dim i As Long, j As Long, k As Long Dim lRow As Long, lCol As Integer Dim arr(), maxPoint As Double Dim temp() '//结果数组，表头字段 ReDim temp(1 To 5, 1 To 1) temp(1, 1) = "准考证号" temp(2, 1) = "姓名" temp(3, 1) = "班级" temp(4, 1) = "学科" temp(5, 1) = "分数" '//把成绩装入数组arr With Sheet1 lRow = .Cells(.Rows.Count, 1).End(xlUp).row lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column arr = .Cells(1, 1).Resize(lRow, lCol).Value End With
第二部分、循环数组arr，把各科第一名成绩提取到数组temp，再一次性写入目标工作表： '//循环数组arr，进行数据处理 For i = 4 To lCol '//先循环列，科目 '//取得当前科目最大值 maxPoint = Application.WorksheetFunction.Max(Application.Index(arr, 0, i)) '//再循环arr的行，把分数等于最高分数的记录添加到数组temp For j = 2 To lRow If arr(j, i) = maxPoint Then k = UBound(temp, 2) + 1 ReDim Preserve temp(1 To 5, 1 To k) temp(1, k) = arr(j, 1) temp(2, k) = arr(j, 2) temp(3, k) = arr(j, 3) temp(4, k) = arr(1, i) temp(5, k) = arr(j, i) End If Next Next '//把temp转置后写入目标工作表 lRow = UBound(temp, 2) lCol = UBound(temp, 1) With Sheet2 .UsedRange.Cells.Clear Set rng = .Cells(1, 1).Resize(lRow, lCol) With rng .Columns(1).NumberFormat = "@" .Value = Application.Transpose(temp) .Borders.LineStyle = 1 End With End With MsgBox "Done!" Sheet2.ActivateEnd Sub
![]()
| 安利小店
安利的牙膏非常不错，用了以后就不想再用其他的了；洗洁精、洗衣液也是日常必备，用过都说好！ |
![]()
| 合谷医疗
合谷医疗专攻各种疑难杂症，尤其擅长抑郁症、焦虑失眠、儿童神经发育异常、多动症、自闭孤独症、腰颈椎疾病治疗，可谓神乎其技！体验过的直呼早点来就好了！ |
喜欢就点个赞、点在看、留言评论、分享一下呗！感谢支持！
