自动计分（已解决）

jx928867128

自动计分.zip (15.75 KB, 下载次数: 4)

2023-3-15 18:22 上传

点击文件名下载附件

zxsea_7426

表头规范了一下：

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     If Target.Count > 1 Then Exit Sub
   
3.     If Target.Row > 3 Then
   
4.         If Target.Column = 5 Or Target.Column = 7 Or Target.Column = 9 Or Target.Column = 11 Or Target.Column = 13 Then
   
5.             If Target.Value = "" Then
   
6.                 Target.Offset(0, 1) = ""
   
7.             Else
   
8.                 体育项目 = Cells(2, Target.Column).Value
   
9.                 性别 = Cells(Target.Row, 4).Value
   
10.                 工作表名 = 性别 & "生评分标准"
    
11.                 成绩 = Target.Value
    
12.                 With Sheets(工作表名)
    
13.                     row_ = .[a1048576].End(3).Row
    
14.                     col_ = .Cells(2, Columns.Count).End(1).Column
    
15.                     ar = .Range(.[a1], .Cells(row_, col_))
    
16.                     For j = 2 To UBound(ar, 2)
    
17.                         If InStr(ar(2, j), 体育项目) > 0 Then
    
18.                             目标列 = j
    
19.                             Exit For
    
20.                         End If
    
21.                     Next j
    
22.                     For i = 3 To UBound(ar)
    
23.                             If (InStr(ar(2, 目标列), "分") > 0 And Not InStr(ar(2, 目标列), "分钟")) > 0 Or InStr(ar(2, 目标列), "秒") > 0 Then
    
24.                                 If 成绩 <= ar(i, 目标列) Then
    
25.                                     Target.Offset(0, 1).Value = ar(i, 1)
    
26.                                     Exit For
    
27.                                 End If
    
28.                             Else
    
29.                                 If 成绩 >= ar(i, 目标列) Then
    
30.                                     Target.Offset(0, 1).Value = ar(i, 1)
    
31.                                     Exit For
    
32.                                 End If
    
33.                             End If
    
34.                             If i = UBound(ar) Then Target.Offset(0, 1) = 0
    
35.                     Next i
    
36.                 End With
    
37.             End If
    
38.         End If
    
39.     End If
    
40. End Sub
    

复制代码

zxsea_7426

代码审核去了。还是上个附件。

jx928867128

zxsea_7426 发表于 2023-3-15 20:24
代码审核去了。还是上个附件。

非常感谢您的帮忙，太感谢了，我去测试下哈

jx928867128

zxsea_7426 发表于 2023-3-15 20:24
代码审核去了。还是上个附件。

老师好，非常感谢您的帮忙，我在测试时发现如果表下面再增加学生的数据，程序出错，不知道是不是我在哪里操作出了问题啊

zxsea_7426

jx928867128 发表于 2023-3-15 21:43
老师好，非常感谢您的帮忙，我在测试时发现如果表下面再增加学生的数据，程序出错，不知道是不是我在哪里 ...

我这边测试没有问题

你哪边出现什么问题不是太清楚。

jx928867128

zxsea_7426 发表于 2023-3-15 22:19
我这边测试没有问题

你哪边出现什么问题不是太清楚。

好的，我再认真检查下哈，祝您生活愉快

jx928867128

zxsea_7426 发表于 2023-3-15 22:19
我这边测试没有问题

你哪边出现什么问题不是太清楚。

在工作中今天还发了一贴了，一直没有人解决，不知您方便抽空帮我看看吗https://club.excelhome.net/threa ... tml?_dsign=ccb1cdde