统计人员考核达标次数

gwjkkkkk

qlmgu 发表于 2024-2-17 18:52
各位老师，早上发帖时发现了表达和逻辑问题，想修改却发现要等很长时间，来不及纠正我的错误，给各位老师带 ...

改一句就可以了。。。

qlmgu

gwjkkkkk 发表于 2024-2-17 19:00
改一句就可以了。。。

gwjkkkkk老师，感谢您的体量。这么快就修改了程序。我运行后目测发现姓名10达标数可能是我表述的原因结果需要修正：序号10 姓名10 是2项达标；序号11，姓名10是三项达标，最终结果以序号11的为准（第一个指标某人只要一次达标，就认为其他都达标）。在结果里姓名有两次出现的基本都是这样的问题。

qlmgu

gwjkkkkk 发表于 2024-2-17 19:00
改一句就可以了。。。

gwjkkkkk老师，我刚才回复您了，又要长时间等待。真是抱歉再三了。序号10的姓名10结果需要修正。同时，达标数字超过9的都需要修正。抱歉。

shiruiqiang

qlmgu 发表于 2024-2-17 19:08
gwjkkkkk老师，我刚才回复您了，又要长时间等待。真是抱歉再三了。序号10的姓名10结果需要修正。同时，达 ...

去重代码更少

qlmgu

shiruiqiang 发表于 2024-2-17 19:11
去重代码更少

shiruiqiang老师真要再三感谢您：这个去重后的代码目前运行结果准确。谢谢老师 又帮了大忙。

ykcbf1100

附件供参考。。。

ykcbf1100

代码供参考。。。

1. Sub ykcbf()  '//2024.2.17
   
2.     arr = Sheets("Sheet1").UsedRange
   
3.     ReDim brr(1 To UBound(arr), 1 To 4)
   
4.     For i = 2 To UBound(arr)
   
5.         m = m + 1
   
6.         Sum = 0
   
7.         For x = 1 To 3
   
8.             brr(m, x) = arr(i, x)
   
9.         Next
   
10.         If arr(i, 1) <> Empty Then
    
11.             For j = 1 To UBound(arr, 2)
    
12.                 If arr(i, j) <> Empty Then
    
13.                     If arr(i, j) = "达标" Then
    
14.                         Sum = Sum + 1
    
15.                     End If
    
16.                 End If
    
17.             Next
    
18.         End If
    
19.         brr(m, 4) = Sum
    
20.     Next
    
21.     With Sheets("统计结果")
    
22.         .UsedRange.Offset(1) = ""
    
23.         .[a2].Resize(m, 4) = brr
    
24.     End With
    
25. End Sub
    

复制代码

lushang2018

1. Sub 测试()
   
2.     Dim i%, j%, k%, m%, n%, arr, brr, crr, drr
   
3.     Dim rng As Range, sht As Worksheet, wbk As Workbook
   
4.     Dim dic As Object, key, keys, items
   
5.     Set dic = CreateObject("scripting.dictionary")
   
6.     arr = Sheet1.Range("A1").CurrentRegion.Value
   
7.     For i = 2 To UBound(arr)
   
8.         key = arr(i, 2) & "," & arr(i, 3)
   
9.         For j = 3 To UBound(arr, 2)
   
10.             If arr(i, j) = "达标" Then
    
11.                 dic(key) = dic(key) + 1
    
12.             End If
    
13.         Next
    
14.     Next
    
15.     keys = dic.keys
    
16.     ReDim brr(1 To dic.Count, 1 To 4)
    
17.     For i = LBound(keys) To UBound(keys)
    
18.         brr(i + 1, 1) = i + 1
    
19.         brr(i + 1, 2) = Split(keys(i), ",")(0)
    
20.         brr(i + 1, 3) = Split(keys(i), ",")(1)
    
21.         brr(i + 1, 4) = dic.items()(i)
    
22.     Next
    
23.     Sheet2.Range("A2").Resize(dic.Count, 4) = brr
    
24. End Sub

复制代码

qlmgu

ykcbf1100 发表于 2024-2-17 20:09
附件供参考。。。

ykcbf1100 老师您好，得到您的帮助很高兴，谢谢您。
下面这些细节我说的不够清楚：指标1里，相同的姓名，只要有一次达标就评定指标1达标。
所以：
数据表：姓名10，指标1比较特殊，有一个达标就可以判定为达标；其他有类型情况的在指标1都这样处理。


结果表里：姓名10应该判定为达标3次，删除达标2次那行。


其他指标都是一个姓名一种结果。

ykcbf1100

qlmgu 发表于 2024-2-17 20:58
ykcbf1100 老师您好，得到您的帮助很高兴，谢谢您。
下面这些细节我说的不够清楚：指标1里，相同的 ...

我再看一下。