一批身份证地址确定其省份与一级市名称，程序弄好了但效率低下

somepeople

1. Sub GetTheCity()
   
2. Dim i, j, k, P1, P2, L As Long
   
3. Dim FirstCity, ShengFen As String
   
4. i = Application.Min(1, 2, 3)
   
5. For i = 2 To Application.WorksheetFunction.CountA(Columns(1))
   
6. 
   
7.    
   
8.     '确定省份名称
   
9.     If InStr(Left(Cells(i, 1), 3), "省") <> 0 Then
   
10.         P1 = InStr(Left(Cells(i, 1), 3), "省") + 1
    
11.     ElseIf InStr(Left(Cells(i, 1), 3), "广西") + InStr(Left(Cells(i, 1), 3), "西藏") + InStr(Left(Cells(i, 1), 3), "宁夏") + InStr(Left(Cells(i, 1), 3), "新疆") <> 0 Then
    
12.         P1 = 3
    
13.     ElseIf InStr(Left(Cells(i, 1), 3), "内蒙古") <> 0 Then
    
14.         P1 = 4
    
15.     Else
    
16.         P1 = 0
    
17.     End If
    
18. 
    
19.     '确定 一级市名称的首字符位置
    
20.    If P1 = 0 Then
    
21.         '找不到省份，就将找 XXX 市
    
22.        P2 = InStr(Left(Cells(i, 1), 5), "市")
    
23.    Else
    
24.         '找到省份或自治区，则找到 首个 市、县、区、州
    
25.         For j = 0 To Len(Cells(i, 1))
    
26.             If Mid(Cells(i, 1), P1 + j, 1) = "市" Or Mid(Cells(i, 1), P1 + j, 1) = "县" Or Mid(Cells(i, 1), P1 + j, 1) = "区" Or Mid(Cells(i, 1), P1 + j, 1) = "州" Then
    
27.                 P2 = j
    
28.                 Exit For
    
29.             End If
    
30.         Next
    
31.     End If
    
32. 
    
33.     '确定市名称
    
34.     If P1 = 0 Then
    
35.         FirstCity = Left(Cells(i, 1), P2 - 1)
    
36.     Else
    
37.         FirstCity = Left(Right(Cells(i, 1), Len(Cells(i, 1)) - P1 + 1), P2)
    
38.     End If
    
39.     If P1 = 0 Then
    
40.         ShengFen = FirstCity '找不到省行的时候，直接将首个市的名称赋予
    
41.     Else
    
42.         ShengFen = Left(Cells(i, 1), P1 - 1) '找到省份
    
43.     End If
    
44.     Cells(i, 2) = ShengFen
    
45.     Cells(i, 3) = FirstCity
    
46. Next
    
47. 
    
48.     '从字符切割出来的市名称与省名称，从数据源中锁定标准 市、省名称
    
49.     For i = 2 To Application.WorksheetFunction.CountA(Columns(1))
    
50.         For L = 2 To Application.WorksheetFunction.CountA(Sheet3.Columns(1))
    
51.             '找到直辖市，则直接确定为省、市为直辖市
    
52.             If InStr(Left(Cells(i, 1), 5), "北京") + InStr(Left(Cells(i, 1), 5), "上海") + InStr(Left(Cells(i, 1), 5), "天津") + InStr(Left(Cells(i, 1), 5), "重庆") <> 0 Then
    
53.                 Cells(i, 4) = Cells(i, 3)
    
54.                 Cells(i, 5) = Cells(i, 3)
    
55.                 Exit For
    
56.             End If
    
57.             '非直辖市，则 以省、市名称同时匹配数据源
    
58.              If InStr(Sheet3.Cells(L, 7), Cells(i, 3)) > 0 And InStr(Sheet3.Cells(L, 2), Cells(i, 2)) > 0 Then
    
59.                 Cells(i, 4) = Sheet3.Cells(L, 5)
    
60.                 Cells(i, 5) = Sheet3.Cells(L, 2)
    
61.                 Exit For
    
62.             End If
    
63.         Next
    
64.     Next
    
65. 
    
66.     '补丁：如果 市、省份名称未能匹配， 则以 仅以市名称去匹配了
    
67.     For i = 2 To Application.WorksheetFunction.CountA(Columns(1))
    
68.         If Cells(i, 4) = "" Then
    
69.         For L = 2 To Application.WorksheetFunction.CountA(Sheet3.Columns(1))
    
70.             If InStr(Sheet3.Cells(L, 7), Cells(i, 3)) > 0 Then
    
71.                 Cells(i, 4) = Sheet3.Cells(L, 5)
    
72.                 Cells(i, 5) = Sheet3.Cells(L, 2)
    
73.                 Exit For
    
74.             End If
    
75.         Next
    
76.         End If
    
77.     Next
    
78. End Sub

复制代码