模糊查找地址 匹配所在的省市县区

yjh_27

相关链接

如何用vba实现模糊查找   44L 45L
http://club.excelhome.net/thread-900005-1-1.html

如何根据县市区匹配所在省市县区
http://club.excelhome.net/thread-1070539-1-1.html


求大神帮我做一个宏，以达到省市区的自动匹配
http://club.excelhome.net/thread-1196339-1-1.html


附件，数据来源
根据县提取所属城市，根据城市提取省份   
http://club.excelhome.net/thread-1160521-1-1.html

jpj123

帮你顶起来吧，很纠结的问题。

nigulas7

谢谢分享！！！

grf1973

1. Sub 提取()
   
2.     Set d = CreateObject("scripting.dictionary")  '全部
   
3.     Set d1 = CreateObject("scripting.dictionary")  '全部市
   
4.     Set d2 = CreateObject("scripting.dictionary")    '全部省
   
5.     arr = Sheets("省市县代码对照表").[a1].CurrentRegion
   
6.     ReDim brr(1 To UBound(arr), 1 To 3)     '省-市-县的对应关系
   
7.     For i = 2 To UBound(arr)
   
8.         x = arr(i, 4)  '代码
   
9.         dm = arr(i, 3)  '地名
   
10.         d(x) = dm
    
11.          If Right(x, 2) <> "00" Then   '最后两个非00，县级
    
12.             n = n + 1
    
13.             brr(n, 1) = d(Left(x, 2) & "0000")   '省级
    
14.             brr(n, 2) = d(Left(x, 4) & "00")    '市级
    
15.             If brr(n, 2) = "市辖区" Or brr(n, 2) = "县" Or brr(n, 2) = "市" Then brr(n, 2) = ""
    
16.             If Len(brr(n, 2)) > 0 Then d1(brr(n, 2)) = brr(n, 1)      '全部市对应省
    
17.             d2(brr(n, 1)) = ""       '全部省
    
18.             brr(n, 3) = dm    '县级
    
19.         End If
    
20.     Next
    
21.    
    
22.     For i = 1 To n - 1     '县级名称按字符长度排序(因为用instr比较,会把短名包含在长名中,所以要先检查是否有长名)
    
23.         For j = i + 1 To n
    
24.             If Len(brr(i, 3)) < Len(brr(j, 3)) Then
    
25.                 For P = 1 To 3
    
26.                     tmp = brr(i, P): brr(i, P) = brr(j, P): brr(j, P) = tmp
    
27.                 Next
    
28.             End If
    
29.         Next
    
30.     Next
    
31.    
    
32.     arr = Sheet1.Range("b3:b" & Sheet1.[b65536].End(3).Row)
    
33.     ReDim crr(1 To UBound(arr), 1 To 3)   '结果数组
    
34.     For i = 1 To UBound(arr)
    
35.         x = arr(i, 1)        '长地名
    
36.         For k = 1 To n   '先查县
    
37.             dm = brr(k, 3)
    
38.             If InStr(x, dm) > 0 Then
    
39.                 crr(i, 1) = brr(k, 1)
    
40.                 crr(i, 2) = brr(k, 2)
    
41.                 crr(i, 3) = dm
    
42.                 Exit For
    
43.             End If
    
44.         Next
    
45.         
    
46.         If k > n Then    '查不到县查市
    
47.             f = 0
    
48.             For Each dm In d1.keys
    
49.                 If InStr(x, dm) > 0 Then
    
50.                     crr(i, 1) = d1(dm)
    
51.                     crr(i, 2) = dm
    
52.                     f = 1
    
53.                     Exit For
    
54.                 End If
    
55.             Next
    
56.         
    
57.             If f = 0 Then  '查不到市查省
    
58.                 For Each dm In d2.keys
    
59.                     If InStr(x, dm) > 0 Then
    
60.                         crr(i, 1) = dm
    
61.                         Exit For
    
62.                     End If
    
63.                 Next
    
64.             End If
    
65.         End If
    
66.     Next
    
67.     Sheet1.[c3].Resize(i - 1, 3) = crr
    
68. End Sub

复制代码

grf1973

请看附件。由于数据的不规范性，所以有些数据无法对应到相应的省市。绝大部分还是能对应到的。另外对照表里的数据整理也做了，可查看。

yjh_27

补充  省市县代码对照表
增加 详细地址

我的代码 已考虑了：
同名县（区）  

广东省

白云区

贵州省

白云区

地址长度 优先匹配

内蒙古自治区

白云矿区

可设置曾用、缩写
如：襄阳 襄樊
       二连浩特市 二连市
可屏蔽详细地址中的干扰词
如 平安保险公司

青海省

平安县

这需在省市县代码对照表 自行补充完善。



应用
求大神帮助批量补全省市区地址信息，谢谢！  20L
http://club.excelhome.net/thread-1277778-1-1.html
(出处: ExcelHome技术论坛)

kszcs

留下记号，高手的经典

自己151

跟着水一下。

smhf_6

这件事，不是经常有，但每年总会碰到那么一二次。
由于 原始数据的不规范，且同名很多，不仅仅是两个村名是相同的，也有A县县名与B县某村村名相同，甚至与地址中的路名相同，也有A镇镇名与该镇某村名相，等等千奇百怪，能有90%的正确率也是不错了

lhq0592

谢谢，学习一下