求助：如何指定某列跟其它多列比较，如存在则写入相应数值，否则高亮以提示为未处...

Prowebreg · 发表于 2018-7-8 01:08

这是一朋友每月要统计的工作，最初是全手工逐一核对填入相应数值，这样反复的操作花时间不说最重要的问题是容易出错。后来我自己在网上参考了一些现成的代码，用公式“=LOOKUP(1,0/(E3=$Q$3:$Q$210),$R$3:$R$210)”可以批量填入数值，之后再定位全选公式出错的单元格将其删除。但又遇到了另一问题，就是在某一人员多次缴费时这公式好像只会填入最后一项的值而不是累加值。再次参考了网上比较单列重复项并标注颜色的VBA代码经少许修改后可以快速找出多次缴费的人员，再手工求和并只留一行。这样效率是高了一点，但还是需要太多的手工介入并不太理想。

很想学一点基本的VBA知识，也本想自己慢慢去做出一套较完善的方案，可是时间太赶了在短期内想自己做出来是完全不可能了，所以想请高手们先为代劳看看有否能实现这操作的代码解决燃眉之急，有空时个人再看看能不能理解代码的原理，谢谢！

将R列数值写入到C、F、I、L、O列对应位置

1

2

3

表格样板.rar (13.6 KB, 下载次数: 14)

Prowebreg · 发表于 2018-7-8 01:11

提问补充：因存在同名同姓的姓名，要以身份证号作为比较依据

蓝桥玄霜 · 发表于 2018-7-8 10:09

请见代码。

Prowebreg · 发表于 2018-7-8 14:35

蓝桥玄霜发表于 2018-7-8 10:09
请见代码。

首先谢过蓝桥玄霜版主给出的代码！刚才按图中的内容键入测试确实解决了最重点的问题。可是没有高亮R列未处理的内容，高亮的目的是提示用户在主统计表中缺少这些人员，要把相应人员信息添加后再重新操作，如高亮提示能很容易看出那些是缺少的人员。

蓝桥玄霜 · 发表于 2018-7-9 08:34

Sub lqxs()
Dim d, Arr, i&, j&
Set d = CreateObject("Scripting.Dictionary")
Sheet1.Activate
Arr = [a1].CurrentRegion
[q3:q19].Interior.ColorIndex = xlNone
For i = 3 To UBound(Arr)
d(Arr(i, 17)) = d(Arr(i, 17)) + Arr(i, 18)
Next
For j = 2 To UBound(Arr, 2) - 4 Step 3
For i = 3 To UBound(Arr)
If Arr(i, j) = "" Then Exit For
If d.exists(Arr(i, j)) Then
Cells(i, j + 1) = d(Arr(i, j))
Else
Cells(i, 17).Interior.ColorIndex = 6
End If
Next
Next
MsgBox "OK"
End Sub

复制代码

Prowebreg · 发表于 2018-7-10 22:53

蓝桥玄霜发表于 2018-7-9 08:34

高亮的代码是有点异常，未能正确的提示不存在的人员。老师第一次给出的代码已足够了，我自己另加了一高亮未找到人员的宏，现在分两步去完成。虽然还是不能一步完成，但现在已基本解决了想解决的问题，再次谢谢。知道不能小小的事情都要在这里左问右问的，剩下的我慢慢去完善。

现在又有一个新问题，就是这贴的问题得到解决了要不要把帖的类别设为已解决？

		自动登录	找回密码
密码			免费注册

[求助] 求助：如何指定某列跟其它多列比较，如存在则写入相应数值，否则高亮以提示为未处...