等级评定

wangzqxa

请大佬写个VBA：
1、在单元格J3、L3、N3、P3、R3、U3、W3、Y3、AA3、AC3、AE3为分值，其中：J3、L3、N3、P3、R3为体能分值；U3、W3、Y3、AA3、AC3、AE3为技能分值。
2、AG3为消控分数，AH3为理论分数，S3为体能合计分，AF3为技能合计分。
3、AJ3为总分值，已计算，不需要另行计算。
4、一档分值为33.34
二档分值为30
三档分值为26.7
四档分值为23.34
五档分值为20.34
5、等级评定标准
（1）体能取3项，即从J3、L3、N3、P3、R3单元格中选取，选取依据为：J3对应I3分值、L3对应K3分值、N3对应M3分值、P3对应O3分值、R3对应Q3分值，如果I3、K3、M3、O3、Q3为空值则不选取相对应的分值；技能取3项，从U3、W3、Y3、AA3、AC3、AE3单元格中选取，选取依据为：U3对应T3分值、W3对应V3分值、Y3对应X3分值、AA3对应Z3分值、AA3对应AB3分值、AE3对应AD3分值，如果T3、V3、X3、Z3、AB3、AD3为空值则不选取相对应的分值。
（2）自AJ3从高到底排名。
（3）自AJ3从最高分开始判定等级。
一级：总分值95—150，J3、L3、N3、P3、R3、U3、W3、Y3、AA3、AC3、AE3单元格分值分别为一档或二档，且一档不少于3项，同时AH3理论分数和AG3消控分数不低于91，如果AG3消控分数为空值，则不计算AG3消控分数。评级人数为不大于参加考核人数的5%。
二级：总分值91—94.99，J3、L3、N3、P3、R3、U3、W3、Y3、AA3、AC3、AE3单元格分值分别为一档或二档或三档，且一档和二档不少于3项，同时理论分数和消控分数不低于81，如果AG3消控分数为空值，则不计算AG3消控分数。评级人数为不大于参加考核人数的7%。
三级：总分值81—90.99，评级人数为不大于参加考核人数的10%。
四级：总分值71—80.99，评级人数为不大于参加考核人数的30%
五级：总分值60—70.99。
未达评级：总分值低于60。
7、如AJ3总分值相同，按单项分高低排名，依次为AF3技能合计分、AG3消控分数、AH3理论分数、S3体能合计分。
8、 如AJ3总分值未达到相应等级总分值的，则从下一级开始排名。
9、 如某等级评级人数超出百分比的，则超出百分比的顺延到下一级排名。
10、参加考核人数依据为C3单元格往下非空值单元格。
11、等级评定结果对应参加考核人数，写在从AK3开始往下单元格。
12、以上为工作表表名为汇总表。

wangzqxa

AI写的代码，无法达到效果

Sub CalculateScores()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("汇总表")
   
    Dim i As Integer
    Dim lastRow As Integer
    lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
   
    For i = 3 To lastRow
        ' Calculate total physical score
        ws.Cells(i, "S").Value = SumTop3(ws, i, Array("J", "L", "N", "P", "R"), Array("I", "K", "M", "O", "Q"))
        
        ' Calculate total skill score
        ws.Cells(i, "AF").Value = SumTop3(ws, i, Array("U", "W", "Y", "AA", "AC", "AE"), Array("T", "V", "X", "Z", "AB", "AD"))
        
        ' Rank and determine grade
        Dim totalScore As Double
        totalScore = ws.Cells(i, "AJ").Value
        
        Dim grade As String
        grade = DetermineGrade(totalScore, ws.Cells(i, "AG").Value, ws.Cells(i, "AH").Value, ws.Cells(i, "S").Value, ws.Cells(i, "AF").Value)
        ws.Cells(i, "AK").Value = grade
    Next i
End Sub

Function SumTop3(ws As Worksheet, row As Integer, scoreCols As Variant, checkCols As Variant) As Double
    Dim scores() As Double
    Dim i As Integer, j As Integer, k As Integer
    Dim temp As Double
   
    ' Initialize scores array
    ReDim scores(0 To 0)
   
    ' Collect scores
    For i = LBound(scoreCols) To UBound(scoreCols)
        If ws.Cells(row, checkCols(i)).Value <> "" Then
            If UBound(scores) = 0 And scores(0) = 0 Then
                scores(0) = ws.Cells(row, scoreCols(i)).Value
            Else
                ReDim Preserve scores(UBound(scores) + 1)
                scores(UBound(scores)) = ws.Cells(row, scoreCols(i)).Value
            End If
        End If
    Next i
   
    ' Sort scores in descending order
    For j = 0 To UBound(scores) - 1
        For k = j + 1 To UBound(scores)
            If scores(j) < scores(k) Then
                temp = scores(j)
                scores(j) = scores(k)
                scores(k) = temp
            End If
        Next k
    Next j
   
    ' Sum top 3 scores
    Dim sum As Double
    sum = 0
    For i = 0 To Application.Min(2, UBound(scores))
        sum = sum + scores(i)
    Next i
   
    SumTop3 = sum
End Function

Function DetermineGrade(totalScore As Double, controlScore As Double, theoryScore As Double, physicalTotal As Double, skillTotal As Double) As String
    If totalScore >= 95 And totalScore <= 150 And theoryScore >= 91 And (controlScore >= 91 Or IsEmpty(controlScore)) Then
        DetermineGrade = "一级"
    ElseIf totalScore >= 91 And totalScore < 95 And theoryScore >= 81 And (controlScore >= 81 Or IsEmpty(controlScore)) Then
        DetermineGrade = "二级"
    ElseIf totalScore >= 81 And totalScore < 91 Then
        DetermineGrade = "三级"
    ElseIf totalScore >= 71 And totalScore < 81 Then
        DetermineGrade = "四级"
    ElseIf totalScore >= 60 And totalScore < 71 Then
        DetermineGrade = "五级"
    Else
        DetermineGrade = "未达评级"
    End If
End Function

wangzqxa

AI写的代码，无法达到效果
Sub CalculateScores()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("汇总表")
   
    Dim i As Integer
    Dim lastRow As Integer
    lastRow = ws.Cells(ws.Rows.count, "C").End(xlUp).row
   
    For i = 3 To lastRow
        ' Calculate total physical score
        ws.Cells(i, "S").Value = SumTop3(ws, i, Array("J", "L", "N", "P", "R"), Array("I", "K", "M", "O", "Q"))
        
        ' Calculate total skill score
        ws.Cells(i, "AF").Value = SumTop3(ws, i, Array("U", "W", "Y", "AA", "AC", "AE"), Array("T", "V", "X", "Z", "AB", "AD"))
        
        ' Rank and determine grade
        Dim totalScore As Double
        totalScore = ws.Cells(i, "AJ").Value
        
        Dim grade As String
        grade = DetermineGrade(totalScore, ws.Cells(i, "AG").Value, ws.Cells(i, "AH").Value, ws.Cells(i, "S").Value, ws.Cells(i, "AF").Value)
        ws.Cells(i, "AK").Value = grade
    Next i
End Sub

Function SumTop3(ws As Worksheet, row As Integer, scoreCols As Variant, checkCols As Variant) As Double
    Dim scores() As Double
    Dim i As Integer, j As Integer, k As Integer
    Dim temp As Double
   
    ' Initialize scores array
    ReDim scores(0 To 0)
   
    ' Collect scores
    For i = LBound(scoreCols) To UBound(scoreCols)
        If ws.Cells(row, checkCols(i)).Value <> "" Then
            If UBound(scores) = 0 And scores(0) = 0 Then
                scores(0) = ws.Cells(row, scoreCols(i)).Value
            Else
                ReDim Preserve scores(UBound(scores) + 1)
                scores(UBound(scores)) = ws.Cells(row, scoreCols(i)).Value
            End If
        End If
    Next i
   
    ' Sort scores in descending order
    For j = 0 To UBound(scores) - 1
        For k = j + 1 To UBound(scores)
            If scores(j) < scores(k) Then
                temp = scores(j)
                scores(j) = scores(k)
                scores(k) = temp
            End If
        Next k
    Next j
   
    ' Sum top 3 scores
    Dim sum As Double
    sum = 0
    For i = 0 To Application.Min(2, UBound(scores))
        sum = sum + scores(i)
    Next i
   
    SumTop3 = sum
End Function

Function DetermineGrade(totalScore As Double, controlScore As Double, theoryScore As Double, physicalTotal As Double, skillTotal As Double) As String
    If totalScore >= 95 And totalScore <= 150 And theoryScore >= 91 And (controlScore >= 91 Or IsEmpty(controlScore)) Then
        DetermineGrade = "一级"
    ElseIf totalScore >= 91 And totalScore < 95 And theoryScore >= 81 And (controlScore >= 81 Or IsEmpty(controlScore)) Then
        DetermineGrade = "二级"
    ElseIf totalScore >= 81 And totalScore < 91 Then
        DetermineGrade = "三级"
    ElseIf totalScore >= 71 And totalScore < 81 Then
        DetermineGrade = "四级"
    ElseIf totalScore >= 60 And totalScore < 71 Then
        DetermineGrade = "五级"
    Else
        DetermineGrade = "未达评级"
    End If
End Function

ykcbf1100

求助说明就写了那么多，恐无人下手啊。

z865593849

随便写写，后面一些条件没看懂就没写

wangzqxa

ykcbf1100 发表于 2024-12-21 18:55
求助说明就写了那么多，恐无人下手啊。

哈哈哈哈，AI完美解决。

wangzqxa

哈哈哈哈，通过AI对话，滤清思路，提出逻辑不混乱的需求，AI完美解决，这样下去论坛里的大佬会不会没事干了。

ykcbf1100

wangzqxa 发表于 2024-12-22 20:10
哈哈哈哈，AI完美解决。

挺好。。。。