Excel VBA程序开发

qibaoshan Lv.2

关注
本帖最后由 qibaoshan 于 2025-11-9 22:25 编辑

【超难!】输入考评人姓名后自动复制对应考评表格以及对所有被考评人自动统分!!!
具体描述详见附件!!!
请版主和大神们,帮忙看看,谢谢!!!

附件内第三步更新能说明,大家应该可以看懂!!!
希望能够输入考评人姓名后,自动运行VBA!!!

年度绩效考评更新目标内说明.rar   2025-11-9 22:23 上传

92.51 KB, 下载次数: 25

851阅读
37回复 倒序

massCS Lv.2 2楼

这种的不适合用爱发电,太耗精力了

shiruiqiang Lv.6 3楼

粗粗看了一下,需要字典创建。就是模拟数据不多,看懂需要花费一点时间

ykcbf1100 Lv.7 4楼

费时是一方面,另一方面是楼主从不送花,也从不说谢谢,也不回复。

qibaoshan 楼主 5楼

谢谢大家!!!感谢大家的热情!!!

qibaoshan 楼主 6楼

引用: ykcbf1100 发表于 2025-11-9 18:01
费时是一方面,另一方面是楼主从不送花,也从不说谢谢,也不回复。

大神,辛苦你了

massCS Lv.2 7楼

引用: ykcbf1100 发表于 2025-11-9 18:01
费时是一方面,另一方面是楼主从不送花,也从不说谢谢,也不回复。

支持前辈说的,再就是教育系统的那一套碰都不想碰了,头大

ykcbf1100 Lv.7 8楼

引用: qibaoshan 发表于 2025-11-9 18:53
大神,辛苦你了

求助回复是最基本的礼貌,也是对帮助者付出劳动的最大肯定。对助你的人说声谢谢是应该的,如果可能,那就送几朵花吧,反而花也是免费的。

ykcbf1100 Lv.7 9楼

引用: qibaoshan 发表于 2025-11-9 18:53
大神,辛苦你了

完成第1点。后面几点没看明白就没写。

2025年绩效考评2.zip   2025-11-9 19:42 上传

69.27 KB, 下载次数: 21

ykcbf1100 Lv.7 10楼

  1. Sub ykcbf()   '//2025.11.9
  2.     Application.ScreenUpdating = False
  3.     Set d = CreateObject("Scripting.Dictionary")
  4.     arr = Sheets("考核对应表").Range("a1").CurrentRegion.Value
  5.     For i = 3 To UBound(arr)
  6.         For j = 2 To UBound(arr, 2) Step 2
  7.             If Len(arr(i, 1) & "") Then
  8.                 s = arr(i, 1) & " " & arr(2, j)
  9.                 If Not d.Exists(s) Then Set d(s) = New Collection
  10.                 d(s).Add arr(i, j) & " " & arr(i, j + 1)
  11.             End If
  12.         Next
  13.     Next
  14.     With Sheets("打分表")
  15.         .[f3:ao20].ClearContents
  16.         arr = .[a1:ao20].Value
  17.         xm = .[b3].Value
  18.         For i = 3 To UBound(arr) Step 2
  19.             s = xm & " " & arr(i, 4)
  20.             If d.Exists(s) Then
  21.                 For x = 1 To d(s).Count
  22.                     t = Split(d(s)(x))
  23.                     .Cells(i, x + 5) = t(0)
  24.                     .Cells(i + 1, x + 5) = t(1)
  25.                 Next
  26.             End If
  27.         Next
  28.     End With
  29.     Application.ScreenUpdating = True
  30.     MsgBox "OK!"
  31. End Sub



加载更多