求助：同样的代码，为何有的能赋分，有的错误！

lushang2018

各位大神，请看一下我的代码是不是有问题？

1. Sub 批量赋分()
   
2. Dim hs As Long                             '命名一个变量hs
   
3. 
   
4.     hs = Shcj.Range("A1000").End(xlUp).Row '判定成绩输入表的行数
   
5. 
   
6. Dim h As Long
   
7. 
   
8.     For h = 3 To hs
   
9.         nj = Shcj.Cells(h, 1)  '年级
   
10.         xb = Shcj.Cells(h, 2)  '性别
    
11.         xm1 = Shcj.Cells(h, 3) '测试项目1
    
12.         xm2 = Shcj.Cells(h, 5) '测试项目2
    
13.         xm3 = Shcj.Cells(h, 7) '测试项目3
    
14.         
    
15. 
    
16.    Shcj.Cells(h, 4) = 得分1(nj, xb, xm1)  '根据年级、性别、测试项目1写入得分1
    
17.    Shcj.Cells(h, 6) = 得分2(nj, xb, xm2)  '根据年级、性别、测试项目2写入得分2
    
18.    Shcj.Cells(h, 8) = 得分3(nj, xb, xm3)  '根据年级、性别、测试项目2写入得分3
    
19.    Shcj.Cells(h, 9) = Shcj.Cells(h, 4) * 0.2 + Shcj.Cells(h, 6) * 0.4 + Shcj.Cells(h, 8) * 0.4 '项目1占比20%，项目2占比20%,项目3占比40%汇总写入总分
    
20. 
    
21. 
    
22. Next h
    
23. End Sub
    
24. Function 得分1(nj, xb, xm)
    
25.   Set shbz = Sheets(Trim(Str(nj)))      '设置shbz为评分标准
    
26.   If xb = "男" Then lie = 1 Else lie = 2    '如果是男生则按照第一列查找，否则按照第二列查找
    
27. 
    
28.   hangs = shbz.Range("A1000").End(xlUp).Row '判定标准所在的行数
    
29. 
    
30.   For i = 4 To hangs                        '从第4行开始到最后
    
31.   
    
32.     If xm < shbz.Cells(i, lie) Then         '如果输入的成绩小于等于标准所在的行，则按照本行的成绩
    
33.        cj = shbz.Cells(i - 1, 3)
    
34.     Else: xm = shbz.Cells(i, lie)
    
35.        cj = shbz.Cells(i, 3)
    
36.        Exit For
    
37.     End If
    
38.   Next
    
39. 得分1 = cj
    
40. End Function
    
41. Function 得分2(nj, xb, xm)
    
42. 
    
43.   Set shbz = Sheets(Trim(Str(nj)))
    
44.    
    
45.     If xb = "男" Then lie = 4 Else lie = 5
    
46.   
    
47.   hangs = shbz.Range("A1000").End(xlUp).Row
    
48. 
    
49.     For i = 4 To hangs
    
50.         If xm < shbz.Cells(i, lie) Then
    
51.             cj = shbz.Cells(i - 1, 6)
    
52.         Else: xm = shbz.Cells(i, lie)
    
53.             cj = shbz.Cells(i, 6)
    
54.       Exit For
    
55.     End If
    
56.   Next
    
57. 得分2 = cj
    
58. End Function
    
59. Function 得分3(nj, xb, xm)
    
60. 
    
61.   Set shbz = Sheets(Trim(Str(nj)))
    
62.    
    
63.     If xb = "男" Then lie = 7 Else lie = 8
    
64.   
    
65.   hangs = shbz.Range("A1000").End(xlUp).Row
    
66. 
    
67.     For i = 4 To hangs
    
68.         
    
69.         If xm < shbz.Cells(i, lie) Then
    
70.             cj = shbz.Cells(i - 1, 9)
    
71.         Else: xm = shbz.Cells(i, lie)
    
72.             cj = shbz.Cells(i, 9)
    
73.       Exit For
    
74.    
    
75.     End If
    
76.   Next
    
77. 得分3 = cj
    
78. End Function

复制代码

lushang2018

为什么立定跳远能行，其他两项就不行呢？

yjh_27

lushang2018 发表于 2021-3-16 23:24
为什么立定跳远能行，其他两项就不行呢？

得分1，倒序
得分2,3  正序

lushang2018

yjh_27 发表于 2021-3-17 08:46
得分1，倒序
得分2,3  正序

不行，变成这样了！我还是不太理解，麻烦您再解释一下行吗？

yjh_27

lushang2018 发表于 2021-3-17 11:25
不行，变成这样了！我还是不太理解，麻烦您再解释一下行吗？

1. If xm [color=Blue]<[/color] shbz.Cells(i, lie) Then         '如果输入的成绩小于等于标准所在的行，则按照本行的成绩
   
2.        cj = shbz.Cells(i - 1, 3)
   
3.     Else: xm = shbz.Cells(i, lie)
   
4.        cj = shbz.Cells(i, 3)
   
5.        Exit For
   
6.     End If

复制代码

Else: xm = shbz.Cells(i, lie)  不理解,我改了，你把他还原试试

得分1  <
得分2  >
得分3  >
这个对应标准表的排序

yjh_27

lushang2018 发表于 2021-3-17 11:25
不行，变成这样了！我还是不太理解，麻烦您再解释一下行吗？

这样，试试