怎么提取各科成绩第一名？

ylj518

代码运行得不到正确结果，不知哪里有问题，请高手指点！

sdytsxd991122

ylj518

原来是这样，谢谢！

清风竹-

请看附件。

ylj518

清风竹-，运行错误，提示找不到库

wengjl

参与参与

Sub test()
  ' 2024-10-23
  ' https://club.excelhome.net/threa ... tml?_dsign=1fd8ea09
  '
  Dim Arr, Brr(1 To 1, 1 To 13)
  Arr = Sheet1.Range("a1").CurrentRegion
  For kk = 4 To 13
    For i = 2 To UBound(Arr) - 1
      For j = i + 1 To UBound(Arr)
        If Arr(i, kk) < Arr(j, kk) Then
          For y = 1 To 13
            Brr(1, y) = Arr(i, y)
            Arr(i, y) = Arr(j, y)
            Arr(j, y) = Brr(1, y)
          Next y
        End If
      Next j
    Next i
    mxcj = Arr(2, kk)
    Sheet2.[N1].Resize(UBound(Arr), 13) = Arr
    '******
    x2 = 2
    Do While Not (IsEmpty(Sheet2.Cells(x2, 1).Value))
      x2 = x2 + 1
    Loop
    For g = 2 To UBound(Arr)
      If Arr(g, kk) = mxcj Then
        Sheet2.Cells(x2, 1).Value = Arr(g, 1)
        Sheet2.Cells(x2, 2).Value = Arr(g, 2)
        Sheet2.Cells(x2, 3).Value = Arr(g, 3)
        Sheet2.Cells(x2, 4).Value = Arr(1, kk)
        Sheet2.Cells(x2, 5).Value = mxcj
        x2 = x2 + 1
      End If
    Next g
  Next kk
   
End Sub

清风竹-

ylj518 发表于 2024-10-23 10:32
清风竹-，运行错误，提示找不到库

我这里没问题。

micch

1. =LET(rr,TOCOL(MOD(BYCOL(D2:M10/1%%+ROW(2:10),MAX),100)),HSTACK(INDEX(A:C,rr,{1,2,3}),TOCOL(D1:M1),INDEX(D:M,rr,ROW(1:10))))

复制代码

一招秒杀

micch 发表于 2024-10-23 11:08

并列第一的 都要列出来，咋办呢

kyxfyzg

Sub test() arr = Sheet1.Range("a1").CurrentRegion ReDim brr(1 To 1000, 1 To 5) k = 1 For i = 4 To UBound(arr, 2)   m = Sheet1.Application.Max(Columns(i))    For j = 2 To UBound(arr)    If arr(j, i) = m Then         brr(k, 1) = arr(j, 1)         brr(k, 2) = arr(j, 2)         brr(k, 3) = arr(j, 3)         brr(k, 4) = arr(1, i)         brr(k, 5) = arr(j, i)         k = k + 1    End If    Next Next  For i = 1 To UBound(brr)    With Sheet2         If Not IsEmpty(brr(i, 1)) Then         .Cells(i + 1, 1) = brr(i, 1)         .Cells(i + 1, 2) = brr(i, 2)         .Cells(i + 1, 3) = brr(i, 3)         .Cells(i + 1, 4) = brr(i, 4)         .Cells(i + 1, 5) = brr(i, 5)         End If     End With Next End Sub