如何用vba代码根据简称文本查找对应全称？

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

楼主 kevinchengcw	Q: 如何用vba代码根据简称文本查找对应全称？ A: 代码如下： Sub test() Dim Arr, Arr2, Arr3, N&, I&, T&, Str$ Arr = Range("a2:a" & Cells(Rows.Count, 1).End(3).Row).Value '取得简称数据 Arr2 = Range("b2:b" & Cells(Rows.Count, 2).End(3).Row).Value '取得全称数据 ReDim Arr3(LBound(Arr2) To UBound(Arr2)) '定义一个与全称数据相同项目数的数组用于存放结果 For I = LBound(Arr) To UBound(Arr) '循环简称数据各项 Arr(I, 1) = Trim(Arr(I, 1)) '去除首尾空格 Str = "" '初始化字符串变量内容 For T = 1 To Len(Arr(I, 1)) '循环将当前简称项各字符间加上,用于作为后面like语句匹配规则 Str = Str & Mid(Arr(I, 1), T, 1) & "" Next T Arr(I, 1) = Str '将组合后的字符串赋值回数组对应项 Next I For N = LBound(Arr2) To UBound(Arr2) '循环各个全称项 If Trim(Arr2(N, 1)) <> "" Then '如果当前全称项的数据是有效的(非空白字符),则 For I = LBound(Arr) To UBound(Arr) '循环简称数组各项 If Arr2(N, 1) Like Arr(I, 1) Then '对两个数组循环到的当前项进行like匹配,如果匹配成功,则 Arr3(N) = Replace(Arr(I, 1), "", "") '将简称项去除*号后赋值给结果数组对应项 Exit For '退出循环 End If Next I End If Next N [d2].Resize(UBound(Arr3), 1) = Application.Transpose(Arr3) '将结果数组写入工作表对应区域 End Sub 详见素材源帖及附件. 副本药名匹配.rar
2楼 lrlxxqxa	K哥写代码还带详细备注，真细心
3楼 chenlifeng	太厉害了，K哥！我的问题您能看下否？我的有对应难度，还涉及到地址的行政划分，不知道有没有实现的可能？ http://www.exceltip.net/thread-28519-3-1.html 非常感谢！

免责声明

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

评论列表