求助一个复杂的平均分计算

戎马书生222

具体见附件

loirol

前80名瞪眼就瞪出来了，就一个四中的

shiruiqiang

这种总分怎么来？怎么算？

liulang0808

Sub 右箭头3_Click()
    Set d = CreateObject("scripting.dictionary")
    Set dd = CreateObject("scripting.dictionary")
    arr = [a1].CurrentRegion
    brr = [p1].CurrentRegion
    x = 2
    For j = 2 To UBound(brr) Step 2
        For i = x To brr(j, 2) + 1
            For c = 5 To 11
                If Len(arr(i, c)) > 0 Then
                    d("全县" & arr(1, c)) = d("全县" & arr(1, c)) + arr(i, c)
                    dd("全县" & arr(1, c)) = dd("全县" & arr(1, c)) + 1
                    
                    d(arr(i, 3) & "班" & arr(1, c)) = d(arr(i, 3) & "班" & arr(1, c)) + arr(i, c)
                    dd(arr(i, 3) & "班" & arr(1, c)) = dd(arr(i, 3) & "班" & arr(1, c)) + 1
                    
                End If
            Next c
        Next i
        For i = 3 To UBound(brr, 2)
            brr(j, i) = d(brr(j, 1) & brr(1, i)) / dd(brr(j, 1) & brr(1, i))
            brr(j + 1, i) = d(brr(j + 1, 1) & brr(1, i)) / dd(brr(j + 1, 1) & brr(1, i))
        Next i
        x = brr(j, 2) + 1
    Next j
    [p1].CurrentRegion = brr
End Sub

liulang0808

楼主的数据中，学科还用拼音缩写，挺奇怪的，修改了对应关系，模拟的结果，供参考

戎马书生222

shiruiqiang 发表于 2025-3-28 14:00
这种总分怎么来？怎么算？

总分，还是用他的总分。只是物理，化学，生物不用他的

戎马书生222

liulang0808 发表于 2025-3-28 14:04
楼主的数据中，学科还用拼音缩写，挺奇怪的，修改了对应关系，模拟的结果，供参考

这都是上级有关部门的高手整的

nihao123456789

这类题，合适用sql解决。

翁知江安

Sub test()
Dim ar, br, cr, dr As Variant
Dim i, j, k, m, icolumn1, icolumn2 As Integer, isum
Dim d As Object
Set d = CreateObject("scripting.dictionary")
ar = Sheet1.[a1].CurrentRegion
ar = Sheet1.[a1].Resize(UBound(ar), UBound(ar, 2) + 1)
ar(1, UBound(ar, 2)) = "32班": ar(1, UBound(ar, 2) - 1) = "全县"
d(ar(1, UBound(ar, 2))) = UBound(ar, 2): d(ar(1, UBound(ar, 2) - 1)) = UBound(ar, 2) - 1
For j = 5 To UBound(ar, 2) - 2
      ar(1, j) = Sheet1.Cells(1, j + 13)
      d(ar(1, j)) = j
Next
ar(2, UBound(ar, 2)) = 1
For i = 3 To UBound(ar)
    If ar(i - 1, UBound(ar, 2) - 2) > ar(i, UBound(ar, 2) - 2) Then
       ar(i, UBound(ar, 2)) = ar(i - 1, UBound(ar, 2)) + 1
    Else
       If ar(i - 1, UBound(ar, 2) - 2) = ar(i, UBound(ar, 2) - 2) Then
       ar(i, UBound(ar, 2)) = ar(i - 1, UBound(ar, 2))
       End If
    End If
Next
cr = Sheet1.Range("p1:x" & Sheet1.[p65536].End(xlUp).Row)
ReDim dr(1 To UBound(cr) - 1, 1 To UBound(cr, 2) - 2)
For i = 2 To UBound(cr)
    icolumn1 = d(cr(i, 1))
    For j = 3 To UBound(cr, 2)
       icolumn2 = d(cr(1, j))
        For k = 2 To UBound(ar)
            If ar(k, icolumn1) <= cr(i, 2) Then
               If ar(k, icolumn2) > 0 Then
                m = m + 1
               isum = ar(k, icolumn2) + isum
                End If
             Else
              Exit For
            End If
        Next
         If m > 0 Then
           dr(i - 1, j - 2) = Format(isum / m, "0.000")
         Else
           dr(i - 1, j - 2) = "平均数不存在"
          End If
          m = 0: isum = 0
      Next
Next
Sheet1.[r2].Resize(100, 20).ClearContents
Sheet1.[r2].Resize(UBound(dr), UBound(dr, 2)) = dr
MsgBox "ok"
End Sub

翁知江安

楼主，我猜了一下那个“32班”是不是全部所有班级，32班前X名是不是就是指全校排名？