如何模糊匹配邮编号码信息？

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

楼主 liuguansky	Q：如附件，说明：原数据：N列为联系地址，(原)O列为邮编号码(但不一定准确)。求助：根据N列的联系地址，在“邮编数据源”表中查找邮编，并新增一列(O列，原O列变为P列)填入查找得到的邮编号码。要求：先精确查找（联系地址的字数不固定），若找不到，再往左减少一个字再查找。当减少到剩下12个字时，若还找不到匹配的邮编，则显示“市外”。 A： Sub justtest() Dim arr, d, i&, wb As Workbook, j%, arrt() As String Application.ScreenUpdating = False '关闭屏幕刷新 Set d = CreateObject("scripting.dictionary") '创建字典项目 Set wb = GetObject(ThisWorkbook.Path & "\邮编数据源.xls") '获取数据源工作簿 With wb.Worksheets(1) '对数据源表 arr = .Range("a2:b" & .Cells(.Rows.Count, 1).End(3).Row).Value '将数据写入数组 For i = 1 To UBound(arr, 1) d(arr(i, 1)) = arr(i, 2) '添加字典项目 Next End With wb.Close False '关闭工作簿 arr = Range("n2:n" & Cells(Rows.Count, "n").End(3).Row).Value '获取待处理数据 ReDim arrt(1 To UBound(arr, 1), 1 To 1) '定义结果数组 For i = 1 To UBound(arr, 1) For j = Len(arr(i, 1)) To 12 Step -1 '从右向左依次减位循环，进行模糊匹配 If d.exists(Left(arr(i, 1), j)) Then arrt(i, 1) = d(Left(arr(i, 1), j)) '匹配即返回值，并跳出循环 Exit For End If Next j If arrt(i, 1) = "" Then arrt(i, 1) = "市外" '未匹配，处理 Next i Range("o2:o" & Rows.Count).ClearContents Range("o2").Resize(i - 1, 1) = arrt Application.ScreenUpdating = True Set d = Nothing End Sub 该贴已经同步到
2楼亡者天下	过来学习一下
3楼纵鹤擒龙水中月	过来学习一下

免责声明

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

评论列表