如何对姓名进行查找并加以删除标识？

作者：绿色风分类：时间：2022-08-17 浏览：84

楼主
liuguansky

Q；如何对多行以、隔开的姓名进行查找，并加了删除所颜色标识，达到如下图所示的效果：

A：用如下代码可以实现：
清空按钮代码：

Sub just()
With Range("a:a").Font
.Color = 0
.Strikethrough = False
End With
End Sub

查询按钮代码：

Sub justtest()
Dim arr, str1$, i&, dic, arrt, j&, s&, str2$, arrre, arrk
Set dic = CreateObject("scripting.dictionary")
arr = Cells(2, 1).Resize(Cells(Rows.Count, 1).End(3).Row - 1, 1).Value
For i = 1 To UBound(arr, 1)
arrt = Split(arr(i, 1), "、")
s = 1
For j = 0 To UBound(arrt)
m = InStr(s, arr(i, 1), arrt(j))
str1 = i & "," & m
If dic.exists(arrt(j)) Then
dic(arrt(j)) = dic(arrt(j)) & vbTab & str1
Else: dic.Add arrt(j), str1
End If
s = Len(arrt(j)) + 1 + s
Next j
Next i
str2 = Application.InputBox("请输入要查询的姓名", "请输入：", Split(arr(1, 1), "、")(0))
If dic.exists(str2) Then
arrre = Split(dic(str2), vbTab)
For i = 0 To UBound(arrre)
arrk = Split(arrre(i), ",")
With Cells(CInt(arrk(0)) + 1, 1).Characters(Start:=CInt(arrk(1)), Length:=Len(str2)).Font
.Strikethrough = True
.Color = -16777024
End With
Next i
Else: MsgBox "未找到相关姓名记录"
End If
Set dic = Nothing
End Sub

2楼
亡者天下

我挖宝哦！

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，经与ExcelTip.Net站长Apolloh商议并征得其同意，现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，供有需要的人士查询使用，也慰缅曾经的论坛时代。所示各个帖子的原作者如对版权有异议，可与本人沟通提出，或于本站点留言，我们会尽快处理。在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一

评论列表