excel中如何用VBA实现多个非标准称谓替换成一个标准称谓？

Question

比如一个部门有多个别称，但仅有一个标准称谓，如何把人员名单中非标准称谓的全部替换成标准称谓？---假设数据量很大，无法用手工一个个去查找替换。举例如图：

Answer 1

要查找的别称可以连续输入 比如:人力部人力资源RLB.等等
也可以加逗号隔开比如:人力部,人力资源,RLB.等等
在工作表名上点右键选查看代码,粘贴下面的代码后回到工作表界面 按ALT+F8.选择 名称标准化 执行
代码如下:
Sub 名称标准化()
Dim rng As Range
endrow = Range("A65536").End(xlUp).Row
czmc = InputBox("请输入要查找的名称别称:", "名称别称输入","人力部,人力资源,RLB")
bzmc = InputBox("请输入标准名称:", "标准名称输入","人力资源部")
For Each rng In Range("A1:A" & endrow)
If InStr(czmc, rng) Then rng = bzmc
Next
End Sub追问

非常感谢，可是当部门很多时，这样还是需要很大的手工输入量。N个部门就要手工操作N次，有没有一次性替换的做法？我想要达到的效果是平时只需要维护一张别称与标准称谓的表，要替换时只需要在目的表格里执行一次脚本。

追答

可以,你把你那张别称与标准称谓表的 样本贴图上了.或者把这张表的格式写出来 我帮你改一下

追问

那就拜托了！我的表格式如下：
sheet1 要替换部门称谓的表
部门名称 姓名 替换后的部门名称 姓名
sheet2 别称与标准称谓对照表
部门标准称谓 部门别称1 部门别称2 部门别称3 部门别称4

追答

在sheet1上点右键查看代码粘贴
Sub 名称标准化()
Dim rng As Range
endrow1 = Range("A65536").End(xlUp).Row
endrow2 = Sheet2.Range("A65536").End(xlUp).Row
For i = 2 To endrow2
With Sheet2
bzmc = .Cells(i, 1)
endcol = .Range("iv" & i).End(xlToLeft).Column
czmc = Join(Application.Transpose(Application.Transpose(.Range(.Cells(i, 2), .Cells(i, endcol)).Value)), ",")
End With
For Each rng In Range("A1:A" & endrow1)
If InStr(czmc, rng) Then
rng.Offset(0, 2) = bzmc
rng.Offset(0, 3) = rng.Offset(0, 1)
End If
Next
Next
End Sub

追问

不好意思，下午出去刚回来。我测试了一下，有一点小小的漏洞，就是当要替换的部门本身就是标准名称时，不能被复制到“替换后的部门名称”列，还望优化一下代码，谢谢了。

追答

这个问题容易解决,只要查询的值里包含标准名称就可以了
把czmc = Join(Application.Transpose(Application.Transpose(.Range(.Cells(i, 2), .Cells(i, endcol)).Value)), ",")
改为czmc = Join(Application.Transpose(Application.Transpose(.Range(.Cells(i, 1), .Cells(i, endcol)).Value)), ",")
就可以了

Answer 2

无需VBA, 先做一张非标准和标准的多对一的对应表,然后用vlookup精确查找.

子易空间站 - Excel培训专家追问

您好，能否详细指点一下公式？谢谢。我的待替换表与对照表如下图：

追答

加我HI,发表给我,我给你做