求每个班的每个学科的后30%的平均分求公式或vba

tmliyam

灵犀之声 发表于 2024-11-12 16:31
参考附件，这是比较简洁的写法。

如1班语文，后30%是15个人，平均成绩81.33，您的结果是82.28 ；8班也不对，大多是对的。什么原因呢。？

你是那块小饼干

1. =LET(T,SORT(CHOOSECOLS(FILTER($D$2:$J$1478,$A$2:$A$1478=L4),MATCH(K5,$D$1:$J$1,0))),AVERAGE(TAKE(T,ROUNDDOWN(ROWS(T)*0.3,0))))

复制代码

tmliyam

灵犀之声 发表于 2024-11-12 16:31
参考附件，这是比较简洁的写法。

小数点进位的问题。了解了

喂你吃粑粑

1. =LET(X,SORT(FILTER(OFFSET($C$1,1,MATCH($K5,$D$1:$J$1,0),COUNT($A$2:$A$1478),1),$A$2:$A$1478=COLUMN(A1)),1,1,0),AVERAGE(TAKE(X,INT(COUNT(X)*30%))))

复制代码

mykitami

你的公式是错的，所以结果也肯定不对
=LET(a,FILTER(OFFSET($C$2:$C$1478,,MATCH($K5,$D$1:$J$1,)),$A$2:$A$1478=L$4),AVERAGE(FILTER(a,a<PERCENTILE(a,0.3))))

3190496160

Sub 统计平均分()
Application.ScreenUpdating = False
Dim ar As Variant
Dim i As Long, r As Long
Dim br(), brr()
Dim d As Object, dc As Object
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
t = Timer
With Sheets("成绩表")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    y = .Cells(4, Columns.Count).End(xlToLeft).Column
    If r < 2 Or y < 4 Then MsgBox "成绩表为空，请先导入数据！": End
    ar = .Range(.Cells(1, 1), .Cells(r, y))
End With
ReDim brr(1 To UBound(ar), 1 To UBound(ar, 2) - 1)
brr(1, 1) = "序号"
brr(1, 2) = "班级"
For j = 4 To UBound(ar, 2)
    brr(1, j - 1) = ar(1, j)
Next j
For i = 2 To UBound(ar)
    If ar(i, 1) <> "" Then
        d(ar(i, 1)) = d(ar(i, 1)) + 1
        If Not dc.exists(ar(i, 1)) Then Set dc(ar(i, 1)) = CreateObject("scripting.dictionary")
        dc(ar(i, 1))(i) = ""
    End If
Next i
m = 1
For Each k In dc.keys
    m = m + 1
    brr(m, 1) = m - 1
    brr(m, 2) = k & "班"
    sl = d(k)
    If sl * 0.3 = Int(sl * 0.3) Then
        gs = sl * 0.3
    Else
        gs = Int(sl * 0.3) + 1
    End If
    n = 0
    ReDim br(1 To dc(k).Count, 1 To UBound(ar, 2))
    For Each kk In dc(k).keys
        n = n + 1
        For j = 1 To UBound(ar, 2)
            br(n, j) = ar(kk, j)
        Next j
    Next kk
    For j = 4 To UBound(ar, 2)
        zxz = Application.Small(Application.Index(br, 0, j), gs)
        zf = 0
        For i = 1 To n
            If br(i, j) <> "" Then
                If IsNumeric(br(i, j)) Then
                    If br(i, j) <= zxz Then
                        zf = zf + br(i, j)
                    End If
                End If
            End If
       Next i
       brr(m, j - 1) = Format(zf / gs, "0.00")
    Next j
Next k
With Sheets("统计")
    .[a1].CurrentRegion.Borders.LineStyle = 0
    .[a1].CurrentRegion = Empty
    .[a1].Resize(m, UBound(brr, 2)) = brr
    .[a1].Resize(m, UBound(brr, 2)).Borders.LineStyle = 1
    .Activate
End With
Set d = Nothing
Set dc = Nothing
Application.ScreenUpdating = True
MsgBox "耗时：" & Format(Timer - t, "0.00") & "秒！"
End Sub

3190496160

vba完成，仅供参考
工作簿1.rar (120.44 KB, 下载次数: 2)

2024-11-13 10:00 上传

点击文件名下载附件

3190496160

tmliyam 发表于 2024-11-12 17:11
如1班语文，后30%是15个人，平均成绩81.33，您的结果是82.28 ；8班也不对，大多是对的。什么原因呢。？

1班语文应该是81.83，而不是81.33

溺水鱼

1. TRANSPOSE(GROUPBY(A2:A1478,D2:J1478,LAMBDA(x,AVERAGE(TAKE(SORT(x,,-1),-INT(COUNTA(x)*0.3)))),,0))

复制代码

lanjian229

3190496160 发表于 2024-11-13 10:01
1班语文应该是81.83，而不是81.33

这个30%取值的问题，51人的30%是15.3，有舍和入得问题