比赛评分统计表

lzqlaj

用于统计比赛选手的分数，去掉最高、最低分，然后求平均分。好久没来论坛，对于VBA有些生疏了，难免出错，欢迎测试指正。

lsc900707

感谢分享。老师的新作，顶!

hcm19522

參考 ~ ~
J2:J16=SUMPRODUCT(SMALL(B2:I2,ROW($2:$7)))

K2:K16=RANK(J2,J$2:J$16)

M2:W16{=INDEX(A:A,RIGHT(SMALL($K$2:$K$16*100+ROW(K$2:K$16),ROW(A1)),2))

Y2:AG16{=INDEX(A:A,RIGHT(LARGE(MMULT(RIGHT(SMALL($B$2:$I$16+ROW($1:$15)*100,SMALL(IF((MOD(ROW($1:$120),8)>1)*(MOD(ROW($1:$120),8)<>8),ROW($1:$120)),(ROW($1:$15)-1)*6+COLUMN($A:$F))),2)*1,{1;1;1;1;1;1})*100+ROW($2:$16),ROW(A1)),2))

lzqlaj

hcm19522 发表于 2017-4-2 14:52
參考 ~ ~
J2:J16=SUMPRODUCT(SMALL(B2:I2,ROW($2:$7)))

没明白怎么回事。

lzqlaj

扣分项要有负号,如-0.1,直接从原平均分里扣除备注分数。

lzqlaj

Private Sub CommandButton1_Click()
    Dim zhs, gs, rs, k, zd, zx, sum0, sum, h’（去掉原语句中的红色部分，原语句：Dim zhs, gs, rs, k, zd, zx, sum0, sum, h，k ）
    zhs = [B65536].End(xlUp).Row
    gs = Cells(2, 5)
    rs = Cells(2, 3)
    If rs < 1 Then Exit Sub
    Application.ScreenUpdating = False
    If zhs > 3 Then
        Range("e4:e" & zhs).ClearComments
        Range("d4:d" & zhs).Interior.ColorIndex = xlNone’（红色部分应该是d，原语句：Range("e4:e" & zhs).Interior.ColorIndex = xlNone）
    End If
    For k = 1 To rs
        sum0 = Application.WorksheetFunction.sum(Range("d" & 4 + (k - 1) * gs & ":d" & 4 + k * gs - 1))
        zd = Application.Max(Range("d" & 4 + (k - 1) * gs & ":d" & 4 + k * gs - 1))
        zx = Application.Min(Range("d" & 4 + (k - 1) * gs & ":d" & 4 + k * gs - 1))
        sum = sum0 - zd - zx
        Range("e" & 4 + (k - 1) * gs) = sum / (gs - 2)
        If Range("f" & 4 + (k - 1) * gs) <> 0 Then
            Range("e" & 4 + (k - 1) * gs) = Range("e" & 4 + (k - 1) * gs) + Range("f" & 4 + (k - 1) * gs)
            Range("e" & (4 + (k - 1) * gs)).Select
            Range("e" & (4 + (k - 1) * gs)).AddComment
            Range("e" & (4 + (k - 1) * gs)).Comment.Text Text:="平均分扣除备注项"
        End If
        For h = 4 + (k - 1) * gs To 4 + k * gs - 1
            If Cells(h, 4) = zd Then
                Cells(h, 4).Interior.Color = 192
                Exit For
            End If
        Next h
        For h = 4 + (k - 1) * gs To 4 + k * gs - 1
            If Cells(h, 4) = zx Then
                Cells(h, 4).Interior.Color = 192
                Exit For
            End If
        Next h
    Next k
    Application.ScreenUpdating = True
End Sub

lzqlaj

D列中红色标记的是每组的最大、最小值，方便核对结果。